home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_tkdiff.idb / usr / freeware / bin / tkdiff.z / tkdiff
Encoding:
Text File  |  1999-04-16  |  219.3 KB  |  6,528 lines

  1. #!/bin/sh
  2. #-*-tcl-*-
  3. # the next line restarts using wish \
  4. exec /usr/freeware/bin/wish "$0" ${1+"$@"}
  5.  
  6. # $Id: tkdiff,v 1.9 1998/11/06 14:25:36 klassa Exp $
  7.  
  8. ###############################################################################
  9. #
  10. # TkDiff -- A graphical front-end to diff for Unix and NT.
  11. # Copyright (C) 1994-1998 by John M. Klassa.
  12. #
  13. # Usage:
  14. #         To interactively pick files:
  15. #             tkdiff
  16. #
  17. #         Plain files:
  18. #             tkdiff <file1> <file2>
  19. #
  20. #         Plain file with conflict markers:
  21. #             tkdiff -conflict <file>
  22. #
  23. #         Source control RCS/CVS/SCCS/PVCS/Perforce:
  24. #             tkdiff <file> (same as -r)
  25. #             tkdiff -r <file>
  26. #             tkdiff -r<rev> <file>
  27. #             tkdiff -r<rev> -r <file>
  28. #             tkdiff -r<rev1> -r<rev2> <file>
  29. #
  30. # This program is free software; you can redistribute it and/or modify
  31. # it under the terms of the GNU General Public License as published by
  32. # the Free Software Foundation; either version 2 of the License, or
  33. # (at your option) any later version.
  34. #
  35. # This program is distributed in the hope that it will be useful,
  36. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  37. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  38. # GNU General Public License for more details.
  39. #
  40. # You should have received a copy of the GNU General Public License
  41. # along with this program; if not, write to the Free Software
  42. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  43. #
  44. # THINGS TO DO:
  45. #
  46. # the code that parses the command line ought to be separated from the
  47. # code that reads in the files. That way we can parse the command line
  48. # right up front and display potential problems on stdout instead of
  49. # waiting until the window display.
  50. ###############################################################################
  51.  
  52.  
  53. # get this out of the way -- we want to draw the whole user interface
  54. # behind the scenes, then pop up in all of its well-laid-out glory
  55. wm withdraw .
  56.  
  57. # set a couple o' globals that we might need sooner than later
  58. set g(name) "TkDiff"
  59. set g(version) "3.00"
  60. set g(nativeMenus) 1
  61.  
  62. # ok, I'll admit -- this is a personal preference. I suppose I ought to
  63. # move this into the preferences or remove it entirely. Sue me. :-)
  64. option add "*TearOff" false 100
  65.  
  66. ###############################################################################
  67. # determine the name of the temporary directory and the name of
  68. # the rc file, both of which are dependent on the platform.
  69. ###############################################################################
  70. switch $tcl_platform(platform) {
  71.     windows {
  72.         if {[info exists env(TEMP)]} {
  73.             set opts(tmpdir) $env(TEMP)
  74.         } else {
  75.             set opts(tmpdir) C:/temp
  76.         }
  77.         set basercfile "_tkdiff.rc"
  78.     }
  79.     default {
  80.         # Make menus and buttons prettier
  81.         option add *Font -*-Helvetica-Medium-R-Normal-*-12-*
  82.  
  83.         if {[info exists env(TMPDIR)]} {
  84.             set opts(tmpdir) $env(TMPDIR)
  85.         } else {
  86.             set opts(tmpdir) /tmp
  87.         }
  88.         set basercfile ".tkdiffrc"
  89.     }
  90. }
  91.  
  92. ###############################################################################
  93. # compute preferences file location. Note that TKDIFFRC can hold either
  94. # a directory or a file, though we document it as being a file name
  95. ###############################################################################
  96. if {[info exists env(TKDIFFRC)]} {
  97.     set rcfile $env(TKDIFFRC)
  98.     if {[file isdirectory $rcfile]} {
  99.         set rcfile [file join $rcfile $basercfile]
  100.     }
  101.  
  102. } elseif {[info exists env(HOME)]} {
  103.     set rcfile [file join $env(HOME) $basercfile]
  104.  
  105. } else {
  106.     set rcfile [file join "/" $basercfile]
  107. }
  108.  
  109. ###############################################################################
  110. # Fonts are selected based on platform.  Can anyone clean this
  111. # up by finding one set of fonts that looks good everywhere?
  112. # bdo - probably not; fonts are probably best left platform-specific
  113. # For windows I personally recommend Monotype.com, free from Microsoft
  114. # (not that I like Microsoft, but Monotype is a decent fixed width
  115. # font).
  116. ###############################################################################
  117.  
  118. if {$tcl_platform(platform) == "windows"} {
  119.     if {$tk_version >= 8.0} {
  120.         set font "{{Lucida Console} 7}"; # Breaks if you're running
  121.         set bold "{{Lucida Console} 7}"; # Windows with a mono display.
  122.     } else {
  123.         # These XFDs are from Sun's font alias file
  124.         # Also known as 6x13
  125.         set font \
  126.             -misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso8859-1
  127.         # Also known as 6x13bold
  128.         set bold \
  129.             -misc-fixed-bold-r-semicondensed--13-120-75-75-c-60-iso8859-1
  130.     }
  131. } else {
  132.     set font 6x13
  133.     set bold 6x13bold
  134. }
  135.  
  136. ###############################################################################
  137. # more initialization...
  138. ###############################################################################
  139.  
  140. array set g {
  141.     changefile      "tkdiff-change-bars.out"
  142.     destroy         ""
  143.     ignore_event,1  0
  144.     ignore_event,2  0
  145.     ignore_hevent,1 0
  146.     ignore_hevent,2 0
  147.     initOK          0
  148.     mapborder       0
  149.     mapheight       0
  150.     mergefile       "tkdiff-merge.out"
  151.     returnValue     0
  152.     showmerge       0
  153.     started         0
  154.     tempfiles       ""
  155.     thumbMinHeight  10
  156.     thumbHeight     10
  157. }
  158.  
  159. array set finfo {
  160.     pth,1       ""
  161.     pth,2       ""
  162.     title       {}
  163.     tmp,1       0
  164.     tmp,2       0
  165. }
  166.  
  167. ###############################################################################
  168. # These options may be changed at runtime
  169. ###############################################################################
  170.  
  171. array set opts {
  172.     autocenter  1
  173.     autoselect  0
  174.     colorcbs    0
  175.     diffcmd     "diff"
  176.     editor      ""
  177.     geometry    "80x30"
  178.     showcbs     1
  179.     showln      1
  180.     showmap     1
  181.     syncscroll  1
  182.     tagcbs      0
  183.     tagln       0
  184.     tagtext     1
  185. }
  186.  
  187. if {$tcl_platform(platform) == "windows"} {
  188.     set opts(fancyButtons) 1
  189. } else {
  190.     set opts(fancyButtons) 0
  191. }
  192.  
  193. # reporting options
  194. array set report {
  195.     doSideLeft           0
  196.     doLineNumbersLeft    1
  197.     doChangeMarkersLeft  1
  198.     doTextLeft           1
  199.     doSideRight          1
  200.     doLineNumbersRight   1
  201.     doChangeMarkersRight 1
  202.     doTextRight          1
  203.     filename             "tkdiff.out"
  204. }
  205.  
  206.  
  207. if {[string first "color" [winfo visual .]] >= 0} {
  208.     # We have color
  209.     # (but, let's not go crazy...)
  210.     array set opts [subst {
  211.         textopt "-background white -foreground black  -font $font"
  212.         currtag "-background blue -foreground yellow"
  213.         difftag "-background gray -foreground black  -font $bold"
  214.         deltag  "-background red1 -foreground black"
  215.         instag  "-background green3 -foreground black"
  216.         chgtag  "-background DodgerBlue1 -foreground black"
  217.         -       "-background red1 -foreground red1"
  218.         +       "-background green -foreground green"
  219.         !       "-background blue -foreground blue"
  220.     }]
  221.  
  222. } else {
  223.     # Assume only black and white
  224.     set bg "black"
  225.     array set opts [subst {
  226.         textopt "-background white -foreground black -font $font"
  227.         currtag "-background black -foreground white"
  228.         difftag "-background white -foreground black -font $bold"
  229.         deltag  "-background black -foreground white"
  230.         instag  "-background black -foreground white"
  231.         chgtag  "-background black -foreground white"
  232.         -       "-background black -foreground white"
  233.         +       "-background black -foreground white"
  234.         !       "-background black -foreground white"
  235.     }]
  236. }
  237.  
  238. # make sure wrapping is turned off. This might piss off a few people,
  239. # but it would screw up the display to have things wrap
  240. set opts(textopt) "$opts(textopt) -wrap none"
  241.  
  242. ###############################################################################
  243. # Source the rc file, which may override some of the defaults
  244. # Any errors will be reported
  245. ###############################################################################
  246.  
  247. if {[file exists $rcfile]} {
  248.  
  249.     if {[catch {source $rcfile} error]} {
  250.         set startupError [join [list \
  251.                 "There was an error in processing your startup file." \
  252.                 "\n$g(name) will still run, but some of your preferences" \
  253.                 "\nmay not be in effect." \
  254.                 "\n\nFile: $rcfile" \
  255.                 "\nError: $error"] " "]
  256.     }
  257. }
  258.  
  259.  
  260. # a hack to handle older preferences files...
  261. # if the user has a diffopt defined in their rc file, we'll magically
  262. # convert that to diffcmd...
  263. if {[info exists opts(diffopt)]} {
  264.     set opts(diffcmd) "diff $opts(diffopt)"
  265. }
  266.  
  267. ###############################################################################
  268. # Work-around for bad font approximations,
  269. # as suggested by Don Libes (libes@nist.gov).
  270. ###############################################################################
  271. catch {tk scaling [expr 100.0 / 72]}
  272.  
  273. proc do-exit {{returncode {}}} {
  274.     global g
  275.  
  276.     # we don't particularly care if del-tmp fails.
  277.     catch {del-tmp}
  278.  
  279.     if {$returncode == ""} {
  280.         set returncode $g(returnValue)
  281.     }
  282.  
  283.     # exit with an appropriate return value
  284.     exit $returncode
  285. }
  286.  
  287.  
  288. ###############################################################################
  289. # Throw up a modal error dialog.
  290. ###############################################################################
  291.  
  292. proc do-error {msg} {
  293.     global argv0
  294.     tk_messageBox -message "$msg" -title "$argv0: Error" -icon error -type ok
  295. }
  296.  
  297. ###############################################################################
  298. # Throw up a modal error dialog or print a message to stderr.  For
  299. # Unix we print to stderr and exit if the main window hasn't been
  300. # created, otherwise put up a dialog and throw an exception.
  301. ###############################################################################
  302.  
  303. proc fatal-error {msg} {
  304.     global g tcl_platform
  305.  
  306.     if {$tcl_platform(platform) == "windows" || $g(started)} {
  307.         tk_messageBox -title "Error" -icon error -type ok -message $msg
  308.         error "Fatal"
  309.     } else {
  310.         puts stderr $msg
  311.         del-tmp
  312.         do-exit 2
  313.     }
  314. }
  315.  
  316. ###############################################################################
  317. # Return user name.  Credit to Warren Jones (wjones@tc.fluke.com).
  318. ###############################################################################
  319.  
  320. proc whoami {} {
  321.     global env
  322.     if {[info exists env(USER)    ]}      { return $env(USER)    }
  323.     if {[info exists env(LOGNAME) ]}      { return $env(LOGNAME) }
  324.     if {[info exists env(USERNAME)]}      { return $env(USERNAME) }
  325.     if {[info exists env(VCSID)   ]}      { return $env(VCSID) }
  326.     if {[ catch { exec whoami } whoami ]} { return nobody }
  327.     return $whoami
  328. }
  329.  
  330. ###############################################################################
  331. # Return the name of a temporary file
  332. ###############################################################################
  333.  
  334. proc tmpfile {n} {
  335.     global opts
  336.     file join $opts(tmpdir) "[whoami][pid]-$n"
  337. }
  338.  
  339. ###############################################################################
  340. # Execute a command.
  341. # Returns "$stdout $stderr $exitcode" if exit code != 0
  342. ###############################################################################
  343.  
  344. proc run-command {cmd} {
  345.     global opts errorCode
  346.  
  347.     set stderr ""
  348.     set exitcode 0
  349.     set errfile [tmpfile "r"]
  350.  
  351.     set failed [catch "$cmd 2>$errfile" stdout]
  352.     # Read stderr output
  353.     catch {
  354.         set hndl [open "$errfile" r]
  355.         set stderr [read $hndl]
  356.         close $hndl
  357.     }
  358.     if {$failed} {
  359.         switch [lindex $errorCode 0] {
  360.             "CHILDSTATUS" {
  361.                 set exitcode [lindex $errorCode 2]
  362.             }
  363.  
  364.             "POSIX" {
  365.                 if {$stderr == ""} {
  366.                     set stderr $stdout
  367.                 }
  368.                 set exitcode -1
  369.             }
  370.  
  371.             default {
  372.                 set exitcode -1
  373.             }
  374.         }
  375.     }
  376.  
  377.     catch {file delete $errfile}
  378.     return [list "$stdout" "$stderr" "$exitcode"]
  379. }
  380.  
  381. ###############################################################################
  382. # Execute a command.  Die if unsuccessful.
  383. ###############################################################################
  384.  
  385. proc die-unless {cmd file} {
  386.     global opts errorCode
  387.  
  388.     set result [run-command "$cmd >$file"]
  389.     set stdout   [lindex $result 0]
  390.     set stderr   [lindex $result 1]
  391.     set exitcode [lindex $result 2]
  392.  
  393.     if {$exitcode != 0} {
  394.         fatal-error "$stderr\n$stdout"
  395.     }
  396. }
  397.  
  398. ###############################################################################
  399. # Filter PVCS output files that have CR-CR-LF end-of-lines
  400. ###############################################################################
  401.  
  402. proc filterCRCRLF {file} {
  403.     set outfile [tmpfile 9]
  404.     set inp [open $file r]
  405.     set out [open $outfile w]
  406.     fconfigure $inp -translation binary
  407.     fconfigure $out -translation binary
  408.     set CR [format %c 13]
  409.     while ![eof $inp] {
  410.         set line [gets $inp]
  411.         if {[string length $line] && ![eof $inp]} {
  412.             regsub -all "$CR$CR" $line $CR line
  413.             puts $out $line
  414.         }
  415.     }
  416.     close $inp
  417.     close $out
  418.     file rename -force $outfile $file
  419. }
  420.  
  421.  
  422. ###############################################################################
  423. # Return the smallest of two values
  424. ###############################################################################
  425.  
  426. proc min {a b} {
  427.     return [expr $a < $b ? $a : $b]
  428. }
  429.  
  430. ###############################################################################
  431. # Return the largest of two values
  432. ###############################################################################
  433.  
  434. proc max {a b} {
  435.     return [expr $a > $b ? $a : $b]
  436. }
  437.  
  438. ###############################################################################
  439. # Toggle change bars
  440. ###############################################################################
  441. proc do-show-changebars {{show {}}} {
  442.     global opts
  443.     global w
  444.  
  445.     if {$show != {}} {set opts(showcbs) $show}
  446.  
  447.     if {$opts(showcbs)} {
  448.         grid $w(LeftCB)   -row 0 -column 2 -sticky ns
  449.         grid $w(RightCB)  -row 0 -column 1 -sticky ns
  450.     } else {
  451.         grid forget $w(LeftCB)
  452.         grid forget $w(RightCB)
  453.     }
  454. }
  455.  
  456.  
  457. ###############################################################################
  458. # Toggle line numbers.
  459. ###############################################################################
  460. proc do-show-linenumbers {{showLn {}}} {
  461.     global opts
  462.     global w
  463.  
  464.     if {$showLn != {}} {set opts(showln) $showLn}
  465.  
  466.     if {$opts(showln)} {
  467.         grid $w(LeftInfo)  -row 0 -column 1 -sticky nsew
  468.         grid $w(RightInfo) -row 0 -column 0 -sticky nsew
  469.     } else {
  470.         grid forget $w(LeftInfo)
  471.         grid forget $w(RightInfo)
  472.     }
  473. }
  474.  
  475.  
  476. ###############################################################################
  477. # Show line numbers in info windows
  478. ###############################################################################
  479.  
  480. proc draw-line-numbers {} {
  481.     global g
  482.     global w
  483.  
  484.     $w(LeftInfo)  configure -state normal
  485.     $w(RightInfo) configure -state normal
  486.     $w(LeftCB)    configure -state normal
  487.     $w(RightCB)   configure -state normal
  488.  
  489.     set lines(Left)  [lindex [split [$w(LeftText) index end-1lines] .] 0]
  490.     set lines(Right) [lindex [split [$w(RightText) index end-1lines] .] 0]
  491.  
  492.     # Smallest line count
  493.     set minlines [min $lines(Left) $lines(Right)]
  494.  
  495.     # cache all the blank lines for the info and cb windows, and do
  496.     # one big insert after we're done. This seems to be much quicker
  497.     # than inserting them in the widgets one line at a time.
  498.     set linestuff {}
  499.     set cbstuff {}
  500.     for {set i 1} {$i < $minlines} {incr i} {
  501.         append linestuff "$i\n"
  502.         append cbstuff " \n" ;# for now, just put in place holders...
  503.     }
  504.  
  505.     $w(LeftInfo)  insert end $linestuff
  506.     $w(RightInfo) insert end $linestuff
  507.     $w(LeftCB)    insert end $cbstuff
  508.     $w(RightCB)   insert end $cbstuff
  509.  
  510.     # Insert remaining line numbers. We'll cache the stuff to be
  511.     # inserted so we can do just one call in to the widget. This
  512.     # should be much faster, relatively speaking, then inserting
  513.     # data one line at a time.
  514.     foreach mod {Left Right} {
  515.         set linestuff {}
  516.         set cbstuff   {}
  517.         for {set i $minlines} {$i < $lines($mod)} {incr i} {
  518.             append linestuff "$i\n"
  519.             append cbstuff " \n" ;# for now, just put in place holders...
  520.         }
  521.         $w(${mod}Info) insert end $linestuff
  522.         $w(${mod}CB) insert end $cbstuff
  523.     }
  524.  
  525.     $w(LeftCB)    configure -state disabled
  526.     $w(RightCB)   configure -state disabled
  527.  
  528.     $w(LeftInfo) configure -state disabled
  529.     $w(RightInfo) configure -state disabled
  530. }
  531.  
  532. ###############################################################################
  533. # Pop up a window for file merge.
  534. ###############################################################################
  535.  
  536. proc popup-merge {{writeproc merge-write-file}} {
  537.     global g
  538.     global w
  539.  
  540.     set types {
  541.         {{Text Files}    {.txt}}
  542.         {{All Files}     {*}}
  543.     }
  544.  
  545.     set path [tk_getSaveFile \
  546.             -defaultextension ".tcl" \
  547.             -filetypes $types \
  548.             -initialfile [file nativename $g(mergefile)]]
  549.  
  550.  
  551.     if {[string length $path] > 0} {
  552.         set g(mergefile) $path
  553.         $writeproc
  554.     }
  555. }
  556.  
  557.  
  558.  
  559. ###############################################################################
  560. # Split a file containing CVS conflict markers into two temporary files
  561. #    name       Name of file containing conflict markers
  562. # Returns the names of the two temporary files and the names of the
  563. # files that were merged
  564. ###############################################################################
  565.  
  566. proc split-cvs-conflicts {name} {
  567.     global g opts
  568.  
  569.     set first ${name}.1
  570.     set second ${name}.2
  571.  
  572.     set temp1 [tmpfile 1]
  573.     set temp2 [tmpfile 2]
  574.  
  575.     if {[catch {set input [open $name r]}]} {
  576.         fatal-error "Couldn't open file '$name'."
  577.     }
  578.     set first [open $temp1 w]
  579.     lappend g(tempfiles) $temp1
  580.     set second [open $temp2 w]
  581.     lappend g(tempfiles) $temp2
  582.  
  583.     set firstname ""
  584.     set secondname ""
  585.     set output 3
  586.  
  587.     set firstMatch ""
  588.     set secondMatch ""
  589.     set thirdMatch ""
  590.  
  591.     while {[gets $input line] >= 0} {
  592.         if {$firstMatch == ""} {
  593.             if {[regexp {^<<<<<<<* +(.*)} $line]} {
  594.                 set firstMatch {^<<<<<<<* +(.*)}
  595.                 set secondMatch {^=======*}
  596.                 set thirdMatch {^>>>>>>>* +(.*)}
  597.             } elseif {[regexp {^>>>>>>>* +(.*)} $line]} {
  598.                 set firstMatch {^>>>>>>>* +(.*)}
  599.                 set secondMatch {^<<<<<<<* +(.*)}
  600.                 set thirdMatch {^=======*}
  601.             }
  602.         }
  603.         if {$firstMatch != ""} {
  604.             if {[regexp $firstMatch $line]} {
  605.                 set output 2
  606.                 if {$secondname == ""} {
  607.                     regexp $firstMatch $line all secondname
  608.                 }
  609.             } elseif {[regexp $secondMatch $line]} {
  610.                 set output 1
  611.                 if {$firstname == ""} {
  612.                     regexp $secondMatch $line all firstname
  613.                 }
  614.             } elseif {[regexp $thirdMatch $line]} {
  615.                 set output 3
  616.                 if {$firstname == ""} {
  617.                     regexp $thirdMatch $line all firstname
  618.                 }
  619.             } else {
  620.                 if {$output & 1} { puts $first $line }
  621.                 if {$output & 2} { puts $second $line }
  622.             }
  623.         } else {
  624.             puts $first $line
  625.             puts $second $line
  626.         }
  627.     }
  628.     close $input
  629.     close $first
  630.     close $second
  631.  
  632.     if {$firstname == ""} {
  633.         set firstname "old"
  634.     }
  635.     if {$secondname == ""} {
  636.         set secondname "new"
  637.     }
  638.  
  639.     return "{$temp1} {$temp2} {$firstname} {$secondname}"
  640. }
  641.  
  642. ###############################################################################
  643. # Get a revision of a file
  644. #   f       file name
  645. #   index   index in finfo array
  646. #   r       revision, "" for head revision
  647. ###############################################################################
  648.  
  649. proc get-file-rev {f index {r ""}} {
  650.     global finfo
  651.     global opts
  652.     global tcl_platform
  653.  
  654.     if {"$r" == ""} {
  655.         set rev "HEAD"
  656.         set cvsopt  ""
  657.         set rcsopt  ""
  658.         set sccsopt ""
  659.         set pvcsopt ""
  660.         set p4file "$f"
  661.     } else {
  662.         set rev "r$r"
  663.         set cvsopt  "-r $r"
  664.         set rcsopt  "$r"
  665.         set sccsopt "-r$r"
  666.         set pvcsopt "-r$r"
  667.         set p4file "$f#$r"
  668.     }
  669.  
  670.     set finfo(pth,$index) [tmpfile $index]
  671.     set finfo(tmp,$index) 1
  672.  
  673.     # NB: it would probably be a Good Thing to move the definition
  674.     # of the various command to exec, to the preferences dialog.
  675.  
  676.     set dirname [file dirname $f]
  677.     set tailname [file tail $f]
  678.  
  679.     # For CVS, if it isn't checked out there is neither a CVS nor RCS
  680.     # directory.  It will however have a ,v suffix just like rcs.
  681.     # There is not necessarily a RCS directory for RCS, either.  The file
  682.     # always has a ,v suffix.
  683.  
  684.     if {[file isdirectory [file join $dirname CVS]]} {
  685.         set cmd "cvs"
  686.         if {$tcl_platform(platform) == "windows"} {append cmd ".exe"}
  687.         set finfo(lbl,$index) "$f (CVS $rev)"
  688.         die-unless "exec $cmd update -p $cvsopt $f" $finfo(pth,$index)
  689.  
  690.     } elseif {[file isdirectory [file join $dirname SCCS]]} {
  691.         set cmd "sccs"
  692.         if {$tcl_platform(platform) == "windows"} {append cmd ".exe"}
  693.         set finfo(lbl,$index) "$f (SCCS $rev)"
  694.         die-unless "exec $cmd get -p $sccsopt $f" $finfo(pth,$index)
  695.  
  696.      } elseif {[file isdirectory [file join $dirname RCS]]} {
  697.         set cmd "co"
  698.         if {$tcl_platform(platform) == "windows"} {append cmd ".exe"}
  699.         set finfo(lbl,$index) "$f (RCS $rev)"
  700.         die-unless "exec $cmd -p$rcsopt $f" $finfo(pth,$index)
  701.  
  702.     } elseif {[regexp {,v$} $tailname]} {
  703.         set cmd "co"
  704.         if {$tcl_platform(platform) == "windows"} {append cmd ".exe"}
  705.         set finfo(lbl,$index) "$f (RCS $rev)"
  706.         die-unless "exec $cmd -p$rcsopt $f" $finfo(pth,$index)
  707.  
  708.     } elseif {[file exists [file join $dirname vcs.cfg]]} {
  709.         set cmd "get"
  710.         if {$tcl_platform(platform) == "windows"} {append cmd ".exe"}
  711.         set finfo(lbl,$index) "$f (PVCS $rev)"
  712.         die-unless "exec $cmd -p $pvcsopt $f" $finfo(pth,$index)
  713.         filterCRCRLF $finfo(pth,$index)
  714.  
  715.     } elseif {[info exists ::env(P4CLIENT)]} {
  716.         set cmd "p4"
  717.         if {$tcl_platform(platform) == "windows"} {append cmd ".exe"}
  718.         set finfo(lbl,$index) "$f (Perforce $rev)"
  719.         die-unless "exec $cmd print -q $p4file" $finfo(pth,$index)
  720.  
  721.     } else {
  722.         fatal-error "File '$f' is not part of a revision control system."
  723.     }
  724. }
  725.  
  726. ###############################################################################
  727. # Setup ordinary file
  728. #   f       file name
  729. #   index   index in finfo array
  730. ###############################################################################
  731.  
  732. proc get-file {f index} {
  733.     global finfo
  734.  
  735.     if {[file exists $f] != 1} {
  736.         fatal-error "File '$f' does not exist."
  737.     }
  738.     if {[file isdirectory $f]} {
  739.         fatal-error "'$f' is a directory."
  740.     }
  741.  
  742.     set finfo(lbl,$index) "$f"
  743.     set finfo(pth,$index) "$f"
  744.     set finfo(tmp,$index) 0
  745. }
  746.  
  747. ###############################################################################
  748. # Initialize file variables.
  749. ###############################################################################
  750.  
  751. proc init-files {} {
  752.     global argc argv
  753.     global finfo
  754.     global opts
  755.     global g
  756.  
  757.     set g(initOK) 0
  758.     set argindex 0
  759.     set revs 0
  760.     set pths 0
  761.     set conflict 0
  762.  
  763.     # Loop through argv, storing revision args in rev and file args in
  764.     # finfo. revs and pths are counters.
  765.     while {$argindex < $argc} {
  766.         set arg [lindex $argv $argindex]
  767.         switch -regexp -- $arg {
  768.             "^-r$" {
  769.                 incr argindex
  770.                 incr revs
  771.                 set rev($revs) [lindex $argv $argindex]
  772.             }
  773.             "^-r.*" {
  774.                 incr revs
  775.                 set rev($revs) [string range $arg 2 end]
  776.             }
  777.             "^-conflict$" {
  778.                 set conflict 1
  779.             }
  780.             default {
  781.                 incr pths
  782.                 set finfo(pth,$pths) $arg
  783.             }
  784.         }
  785.         incr argindex
  786.     }
  787.  
  788.     # Now check how many revision and file args we have.
  789.     if {$conflict} {
  790.         if {$revs == 0 && $pths == 1} {
  791.             ############################################################
  792.             # tkdiff -conflict FILE
  793.             ############################################################
  794.             set files [split-cvs-conflicts "$finfo(pth,1)"]
  795.             get-file [lindex "$files" 0] 1
  796.             get-file [lindex "$files" 1] 2
  797.             set finfo(lbl,1) [lindex "$files" 2]
  798.             set finfo(lbl,2) [lindex "$files" 3]
  799.         } else {
  800.             fatal "Usage: tkdiff -conflict FILE"
  801.         }
  802.     } else {
  803.         if {$revs == 2 && $pths == 1} {
  804.             ############################################################
  805.             #  tkdiff -rREV1 -rREV2 FILE
  806.             ############################################################
  807.             set f $finfo(pth,1)
  808.             get-file-rev "$f" 1 "$rev(1)"
  809.             get-file-rev "$f" 2 "$rev(2)"
  810.  
  811.         } elseif {$revs == 2 && $pths == 0} {
  812.             ############################################################
  813.             #  tkdiff -rREV -r FILE
  814.             ############################################################
  815.             set f $rev(2)
  816.             get-file-rev "$f" 1 "$rev(1)"
  817.             get-file-rev "$f" 2
  818.  
  819.         } elseif {$revs == 1 && $pths == 1} {
  820.             ############################################################
  821.             #  tkdiff -rREV FILE
  822.             ############################################################
  823.             set f $finfo(pth,1)
  824.             get-file-rev "$f" 1 "$rev(1)"
  825.             get-file "$f" 2
  826.  
  827.         } elseif {$revs == 1 && $pths == 0} {
  828.             ############################################################
  829.             # tkdiff -r FILE
  830.             ############################################################
  831.             set f $rev(1)
  832.             get-file-rev "$f" 1
  833.             get-file "$f" 2
  834.  
  835.         } elseif {$revs == 0 && $pths == 2} {
  836.             ############################################################
  837.             #  tkdiff FILE1 FILE2
  838.             ############################################################
  839.             set f1 $finfo(pth,1)
  840.             set f2 $finfo(pth,2)
  841.             if {[file isdirectory $f1] && [file isdirectory $f2]} {
  842.                 fatal-error "Either <file1> or <file2> must be a plain file."
  843.             }
  844.  
  845.             if {[file isdirectory $f1]} {
  846.                 set f1 [file join $f1 [file tail $f2]]
  847.             } elseif {[file isdirectory $f2]} {
  848.                 set f2 [file join $f2 [file tail $f1]]
  849.             }
  850.  
  851.             get-file "$f1" 1
  852.             get-file "$f2" 2
  853.  
  854.         } elseif {$revs == 0 && $pths == 1} {
  855.             ############################################################
  856.             #  tkdiff FILE
  857.             ############################################################
  858.             set f $finfo(pth,1)
  859.             get-file-rev "$f" 1
  860.             get-file "$f" 2
  861.  
  862.         } else {
  863.             do-error "Invalid command line!\n    $argv\nSee the help for valid command line parameters."
  864.             do-usage
  865.             tkwait window .usage
  866.             destroy .
  867.             error "Fatal"
  868.         }
  869.     }
  870.  
  871.     set finfo(title) "$finfo(lbl,1) vs. $finfo(lbl,2)"
  872.     set rootname [file rootname  $finfo(pth,1)]
  873. #    set path     [file dirname   $finfo(pth,1)]
  874.     set path [pwd]
  875.     set suffix   [file extension $finfo(pth,1)]
  876.     set g(mergefile) [file join $path "${rootname}-merge$suffix"]
  877.     set g(initOK) 1
  878. }
  879.  
  880. ###############################################################################
  881. # Set up the display...
  882. ###############################################################################
  883. proc create-display {} {
  884.  
  885.     global g opts bg tk_version
  886.     global w
  887.  
  888.     # these are the four major areas of the GUI:
  889.     # menubar - the menubar (duh)
  890.     # toolbar - the toolbar (duh, again)
  891.     # client  - the area with the text widgets and the graphical map
  892.     # status us  - a bottom status line
  893.  
  894.     # this block of destroys is only for stand-alone testing of
  895.     # the GUI code, and can be blown away (or not, if we want to
  896.     # be able to call this routine to recreate the display...)
  897.     catch {
  898.         destroy .menubar
  899.         destroy .toolbar
  900.         destroy .client
  901.         destroy .map
  902.         destroy .status
  903.     }
  904.  
  905.     # create the top level frames and store them in a global
  906.     # array..
  907.     set w(client)  .client
  908.     set w(menubar) .menubar
  909.     set w(toolbar) .toolbar
  910.     set w(status)  .status
  911.  
  912.     # other random windows...
  913.     set w(preferences) .pref
  914.     set w(findDialog) .findDialog
  915.     set w(popupMenu)  .popupMenu
  916.  
  917.     # now, simply build all the pieces
  918.     build-menubar
  919.     build-toolbar
  920.     build-client
  921.     build-status
  922.     build-popupMenu
  923.  
  924.     # ... and fit it all together...
  925.     if {$g(nativeMenus)} {
  926.         . configure -menu $w(menubar)
  927.     } else {
  928.         pack $w(menubar) -side top -fill x -expand n
  929.     }
  930.     pack $w(toolbar) -side top -fill x -expand n
  931.     pack $w(client)  -side top -fill both -expand y
  932.     pack $w(status)  -side bottom -fill x -expand n
  933.  
  934.     # Make sure temporary files get deleted
  935.     bind . <Destroy> { del-tmp }
  936.  
  937.     # other misc. bindings
  938.     common-navigation $w(LeftText) $w(LeftInfo) $w(LeftCB) \
  939.             $w(RightText) $w(RightInfo) $w(RightCB)
  940.  
  941.     # normally, keyboard traversal using tab and shift-tab isn't
  942.     # enabled for text widgets, since the default binding for these
  943.     # keys is to actually insert the tab charater. Because all of
  944.     # our text widgets are for display only, let's redefine the
  945.     # default binding so the global <Tab> and <Shift-Tab> bindings
  946.     # are used.
  947.     bind Text <Tab>       {continue}
  948.     bind Text <Shift-Tab> {continue}
  949.  
  950.     wm deiconify .
  951.     focus -force $w(LeftText)
  952.     update idletasks
  953.  
  954.     set g(started) 1
  955. }
  956.  
  957. ###############################################################################
  958. # show the popup menu, optionally changing some of the entries based on
  959. # where the user clicked
  960. ###############################################################################
  961.  
  962. proc show-popupMenu { x y } {
  963.     global w
  964.     global g
  965.  
  966.     set window [winfo containing $x $y]
  967.     if {[winfo class $window] == "Text"} {
  968.         $w(popupMenu) entryconfigure "Find..." -state normal
  969.         $w(popupMenu) entryconfigure "Find Nearest*" -state normal
  970.         $w(popupMenu) entryconfigure "Edit*" -state normal
  971.  
  972.         if {$window == $w(LeftText) || $window == $w(LeftInfo) || \
  973.                 $window == $w(LeftCB)} {
  974.             $w(popupMenu) configure -title "File 1"
  975.             set g(activeWindow) $w(LeftText)
  976.         } else {
  977.             $w(popupMenu) configure -title "File 2"
  978.             set g(activeWindow) $w(RightText)
  979.         }
  980.  
  981.     } else {
  982.         $w(popupMenu) entryconfigure "Find..." -state disabled
  983.         $w(popupMenu) entryconfigure "Find Nearest*" -state disabled
  984.         $w(popupMenu) entryconfigure "Edit*" -state disabled
  985.     }
  986.     tk_popup $w(popupMenu) $x $y
  987. }
  988.  
  989.  
  990. ###############################################################################
  991. # build the right-click popup menu
  992. ###############################################################################
  993.  
  994. proc build-popupMenu {} {
  995.     global w g
  996.  
  997.     # this routine assumes the other windows already exist...
  998.     menu $w(popupMenu)
  999.     foreach win [list LeftText RightText LeftInfo RightInfo \
  1000.             LeftCB RightCB mapCanvas] {
  1001.         bind $w($win) <3> {show-popupMenu %X %Y}
  1002.     }
  1003.  
  1004.     set m $w(popupMenu)
  1005.     $m add command -label "First Diff" -underline 0 \
  1006.             -command [list popupMenu first] \
  1007.             -accelerator "F"
  1008.     $m add command -label "Previous Diff" -underline 0 \
  1009.             -command [list popupMenu previous] \
  1010.             -accelerator "P"
  1011.     $m add command -label "Center Current Diff" -underline 0 \
  1012.             -command [list popupMenu center] \
  1013.             -accelerator "C"
  1014.     $m add command -label "Next Diff"  -underline 0 \
  1015.             -command [list popupMenu next] \
  1016.             -accelerator "N"
  1017.     $m add command -label "Last Diff" -underline 0 \
  1018.             -command [list popupMenu last] \
  1019.             -accelerator "L"
  1020.     $m add separator
  1021.     $m add command -label "Find Nearest Diff" -underline 0 \
  1022.             -command [list popupMenu nearest] \
  1023.             -accelerator "Double-Click"
  1024.     $m add separator
  1025.     $m add command -label "Find..." -underline 0 \
  1026.             -command [list popupMenu find]
  1027.     $m add command -label "Edit" -underline 0 \
  1028.         -command [list popupMenu edit]
  1029. }
  1030.  
  1031. ###############################################################################
  1032. # handle popup menu commands
  1033. ###############################################################################
  1034. proc popupMenu {command args} {
  1035.     global g
  1036.     global w
  1037.  
  1038.     switch $command {
  1039.         center          {$w(centerDiffs) invoke}
  1040.         edit            {do-edit}
  1041.         find            {$w(find)        invoke}
  1042.         first           {$w(firstDiff)   invoke}
  1043.         last            {$w(lastDiff)    invoke}
  1044.         next            {$w(nextDiff)    invoke}
  1045.         previous        {$w(prevDiff)    invoke}
  1046.         nearest         {
  1047.             moveNearest $g(activeWindow) xy \
  1048.                     [winfo pointerx $g(activeWindow)] \
  1049.                     [winfo pointery $g(activeWindow)]
  1050.         }
  1051.     }
  1052. }
  1053.  
  1054. ###############################################################################
  1055. # build the main client display (the text widgets, scrollbars, that
  1056. # sort of fluff)
  1057. ###############################################################################
  1058.  
  1059. proc build-client {} {
  1060.     global g
  1061.     global w
  1062.     global opts
  1063.  
  1064.     frame $w(client)  -bd 2 -relief flat
  1065.  
  1066.     # set up global variables to reference the widgets, so
  1067.     # we don't have to use hardcoded widget paths elsewhere
  1068.     # in the code
  1069.     #
  1070.     # Text  - holds the text of the file
  1071.     # Info  - sort-of "invisible" text widget which is kept in sync
  1072.     #         with the text widget and holds line numbers
  1073.     # CB    - contains changebars or status or something like that...
  1074.     # VSB   - vertical scrollbar
  1075.     # HSB   - horizontal scrollbar
  1076.     # Label - label to hold the name of the file
  1077.     set w(LeftText)  $w(client).left.text
  1078.     set w(LeftInfo)  $w(client).left.info
  1079.     set w(LeftCB)    $w(client).left.changeBars
  1080.     set w(LeftVSB)   $w(client).left.vsb
  1081.     set w(LeftHSB)   $w(client).left.hsb
  1082.     set w(LeftLabel) $w(client).leftlabel
  1083.  
  1084.     set w(RightText)  $w(client).right.text
  1085.     set w(RightInfo)  $w(client).right.info
  1086.     set w(RightCB)    $w(client).right.changeBars
  1087.     set w(RightVSB)   $w(client).right.vsb
  1088.     set w(RightHSB)   $w(client).right.hsb
  1089.     set w(RightLabel) $w(client).rightlabel
  1090.  
  1091.     set w(map)        $w(client).map
  1092.     set w(mapCanvas)  $w(map).canvas
  1093.  
  1094.     # these don't need to be global...
  1095.     set leftFrame  $w(client).left
  1096.     set rightFrame $w(client).right
  1097.  
  1098.     # we'll create each widget twice; once for the left side
  1099.     # and once for the right.
  1100.     label $w(LeftLabel) \
  1101.             -bd 1 -relief flat \
  1102.             -textvariable finfo(lbl,1)
  1103.  
  1104.     label $w(RightLabel) \
  1105.             -bd 1 -relief flat \
  1106.             -textvariable finfo(lbl,2)
  1107.  
  1108.     # this holds the text widgets and the scrollbars. The reason
  1109.     # for the frame is purely for aesthetics. It just looks
  1110.     # nicer, IMHO, to "embed" the scrollbars within the text
  1111.     # widget
  1112.     frame $leftFrame \
  1113.             -bd 1 -relief sunken
  1114.  
  1115.     frame $rightFrame \
  1116.             -bd 1 -relief sunken
  1117.  
  1118.     scrollbar $w(LeftHSB) \
  1119.             -borderwidth 1 \
  1120.             -orient horizontal \
  1121.             -command [list $w(LeftText) xview]
  1122.  
  1123.     scrollbar $w(RightHSB) \
  1124.             -borderwidth 1 \
  1125.             -orient horizontal \
  1126.             -command [list $w(RightText) xview]
  1127.  
  1128.     scrollbar $w(LeftVSB) \
  1129.             -borderwidth 1 \
  1130.             -orient vertical \
  1131.             -command [list $w(LeftText) yview]
  1132.  
  1133.     scrollbar $w(RightVSB) \
  1134.             -borderwidth 1 \
  1135.             -orient vertical \
  1136.             -command [list $w(RightText) yview]
  1137.  
  1138.     scan $opts(geometry) "%dx%d" width height
  1139.  
  1140.     text $w(LeftText) \
  1141.             -padx 4 \
  1142.             -wrap none \
  1143.             -width $width \
  1144.             -height $height \
  1145.             -borderwidth  0 \
  1146.             -setgrid 1 \
  1147.             -yscrollcommand [list vscroll-sync 1] \
  1148.             -xscrollcommand [list hscroll-sync 1]
  1149.  
  1150.     text $w(RightText) \
  1151.             -padx 4 \
  1152.             -wrap none \
  1153.             -width $width \
  1154.             -height $height \
  1155.             -borderwidth  0 \
  1156.             -setgrid 1 \
  1157.             -yscrollcommand [list vscroll-sync 2] \
  1158.             -xscrollcommand [list hscroll-sync 2]
  1159.  
  1160.     text $w(LeftInfo) \
  1161.             -height 0 \
  1162.             -padx 0 \
  1163.             -width 6 \
  1164.             -borderwidth 0 \
  1165.             -setgrid 1 \
  1166.             -yscrollcommand [list vscroll-sync 1]
  1167.  
  1168.     text $w(RightInfo) \
  1169.             -height 0 \
  1170.             -padx 0 \
  1171.             -width 6 \
  1172.             -borderwidth 0 \
  1173.             -setgrid 1 \
  1174.             -yscrollcommand [list vscroll-sync 2]
  1175.  
  1176.     # each and every line in a text window will have a corresponding line
  1177.     # in this widget. And each line in this widget will be composed of
  1178.     # a single character (either "+", "-" or "!" for insertion, deletion
  1179.     # or change, respectively
  1180.     text $w(LeftCB) \
  1181.             -height 0 \
  1182.             -padx 0 \
  1183.             -highlightthickness 0 \
  1184.             -wrap none \
  1185.             -foreground white \
  1186.             -width 1 \
  1187.             -borderwidth 0 \
  1188.             -yscrollcommand [list vscroll-sync 1]
  1189.  
  1190.     text $w(RightCB) \
  1191.             -height 0 \
  1192.             -padx 0 \
  1193.             -highlightthickness 0 \
  1194.             -wrap none \
  1195.             -background white \
  1196.             -foreground white \
  1197.             -width 1 \
  1198.             -borderwidth 0 \
  1199.             -yscrollcommand [list vscroll-sync 2]
  1200.  
  1201.     # Set up text tags for the 'current diff' (the one chosen by the 'next'
  1202.     # and 'prev' buttons) and any ol' diff region.  All diff regions are
  1203.     # given the 'diff' tag initially...  As 'next' and 'prev' are pressed,
  1204.     # to scroll through the differences, one particular diff region is
  1205.     # always chosen as the 'current diff', and is set off from the others
  1206.     # via the 'diff' tag -- in particular, so that it's obvious which diffs
  1207.     # in the left and right-hand text widgets match.
  1208.  
  1209.     foreach widget [list $w(LeftText) $w(LeftInfo) $w(LeftCB) \
  1210.             $w(RightText) $w(RightInfo) $w(RightCB)] {
  1211.         eval "$widget configure $opts(textopt)"
  1212.         foreach tag {difftag currtag deltag instag chgtag + - !} {
  1213.             eval "$widget tag configure $tag $opts($tag)"
  1214.         }
  1215.     }
  1216.  
  1217.     # adjust the tag priorities a bit...
  1218.     foreach window [list LeftText RightText LeftCB RightCB LeftInfo RightInfo] {
  1219.         $w($window) tag raise deltag currtag
  1220.         $w($window) tag raise chgtag currtag
  1221.         $w($window) tag raise instag currtag
  1222.         $w($window) tag raise currtag difftag
  1223.     }
  1224.  
  1225.     # these tags are specific to change bars
  1226.     foreach widget [list $w(LeftCB) $w(RightCB)] {
  1227.         eval "$widget tag configure + $opts(+)"
  1228.         eval "$widget tag configure - $opts(-)"
  1229.         eval "$widget tag configure ! $opts(!)"
  1230.     }
  1231.  
  1232.     # build the map...
  1233.     # we want the map to be the same width as a scrollbar, so we'll
  1234.     # steal some information from one of the scrollbars we just
  1235.     # created...
  1236.     set cwidth [winfo reqwidth $w(LeftVSB)]
  1237.     set color  [$w(LeftVSB) cget -troughcolor]
  1238.  
  1239.     set map [frame $w(client).map \
  1240.             -bd 1 \
  1241.             -relief sunken \
  1242.             -takefocus 0 \
  1243.             -highlightthickness 0]
  1244.  
  1245.     # now for the real map...
  1246.     image create photo map
  1247.  
  1248.     canvas $w(mapCanvas) \
  1249.             -width [expr {$cwidth + 1}] \
  1250.             -yscrollcommand map-resize \
  1251.             -background $color \
  1252.             -borderwidth 0 \
  1253.             -relief sunken \
  1254.             -highlightthickness 0
  1255.     $w(mapCanvas) create image 1 1 -image map -anchor nw
  1256.     pack $w(mapCanvas) -side top -fill both -expand y
  1257.  
  1258.     # I'm not too pleased with these bindings -- it results in a rather
  1259.     # jerky, cpu-intensive maneuver since with each move of the mouse
  1260.     # we are finding and tagging the nearest diff. But, what *should*
  1261.     # it do?
  1262.     #
  1263.     # I think what I *want* it to do is update the combobox and status
  1264.     # bar so the user can see where in the scheme of things they are,
  1265.     # but not actually select anything until they release the mouse.
  1266.     bind $w(mapCanvas) <ButtonPress-1>   [list handleMapEvent B1-Press %y]
  1267.     bind $w(mapCanvas) <Button1-Motion>  [list handleMapEvent B1-Motion %y]
  1268.     bind $w(mapCanvas) <ButtonRelease-1> [list handleMapEvent B1-Release %y]
  1269.  
  1270.     # this is a dummy frame we're going to create that's the
  1271.     # same height as a horizontal scrollbar.
  1272.     frame $w(client).dummyFrame \
  1273.             -borderwidth 0 \
  1274.             -height \
  1275.             [winfo reqheight $w(LeftHSB)]
  1276.  
  1277.     # use grid to manage the widgets in the left side frame
  1278.     grid $w(LeftVSB)  -row 0 -column 0 -sticky ns
  1279.     grid $w(LeftInfo) -row 0 -column 1 -sticky nsew
  1280.     grid $w(LeftCB)   -row 0 -column 2 -sticky ns
  1281.     grid $w(LeftText) -row 0 -column 3 -sticky nsew
  1282.     grid $w(LeftHSB)  -row 1 -column 1 -sticky ew -columnspan 3
  1283.  
  1284.     grid rowconfigure $leftFrame 0 -weight 1
  1285.     grid rowconfigure $leftFrame 1 -weight 0
  1286.  
  1287.     grid columnconfigure $leftFrame 0 -weight 0
  1288.     grid columnconfigure $leftFrame 1 -weight 0
  1289.     grid columnconfigure $leftFrame 2 -weight 0
  1290.     grid columnconfigure $leftFrame 3 -weight 1
  1291.  
  1292.     # likewise for the right...
  1293.     grid $w(RightVSB)  -row 0 -column 3 -sticky ns
  1294.     grid $w(RightInfo) -row 0 -column 0 -sticky nsew
  1295.     grid $w(RightCB)   -row 0 -column 1 -sticky ns
  1296.     grid $w(RightText) -row 0 -column 2 -sticky nsew
  1297.     grid $w(RightHSB)  -row 1 -column 0 -sticky ew -columnspan 3
  1298.  
  1299.     grid rowconfigure $rightFrame 0 -weight 1
  1300.     grid rowconfigure $rightFrame 1 -weight 0
  1301.  
  1302.     grid columnconfigure $rightFrame 0 -weight 0
  1303.     grid columnconfigure $rightFrame 1 -weight 0
  1304.     grid columnconfigure $rightFrame 2 -weight 1
  1305.     grid columnconfigure $rightFrame 3 -weight 0
  1306.  
  1307.     # use grid to manage the labels, frames and map. We're going to
  1308.     # toss in an extra row just for the benefit of our dummy frame.
  1309.     # the intent is that the dummy frame will match the height of
  1310.     # the horizontal scrollbars so the map stops at the right place...
  1311.     grid $w(LeftLabel)         -row 0 -column 0 -sticky ew
  1312.     grid $w(RightLabel)        -row 0 -column 2 -sticky ew
  1313.     grid $leftFrame            -row 1 -column 0 -sticky nsew -rowspan 2
  1314.     grid $map                  -row 1 -column 1 -stick ns
  1315.     grid $w(client).dummyFrame -row 2 -column 1
  1316.     grid $rightFrame           -row 1 -column 2 -sticky nsew -rowspan 2
  1317.  
  1318.     grid rowconfigure $w(client) 0 -weight 0
  1319.     grid rowconfigure $w(client) 1 -weight 1
  1320.     grid rowconfigure $w(client) 2 -weight 0
  1321.  
  1322.     grid columnconfigure $w(client) 0 -weight 1
  1323.     grid columnconfigure $w(client) 1 -weight 0
  1324.     grid columnconfigure $w(client) 2 -weight 1
  1325.  
  1326.     # this adjusts the variable g(activeWindow) to be whatever text
  1327.     # widget has the focus...
  1328.     bind $w(LeftText)  <1> {set g(activeWindow) $w(LeftText)}
  1329.     bind $w(RightText) <1> {set g(activeWindow) $w(RightText)}
  1330.  
  1331.     set g(activeWindow) $w(LeftText) ;# establish a default
  1332.  
  1333.     # this will make the UI toe the line WRT user preferences
  1334.     do-show-map
  1335.     do-show-changebars
  1336.     do-show-linenumbers
  1337.     do-show-map
  1338.  
  1339. }
  1340.  
  1341. ###############################################################################
  1342. # create (if necessary) and show the find dialog
  1343. ###############################################################################
  1344.  
  1345. proc show-find {} {
  1346.     global w g
  1347.  
  1348.     if {![winfo exists $w(findDialog)]} {
  1349.         toplevel $w(findDialog)
  1350.         wm group $w(findDialog) .
  1351.         wm transient $w(findDialog) .
  1352.         wm title $w(findDialog) "$g(name) Find"
  1353.  
  1354.         # we don't want the window to be deleted, just hidden from view
  1355.         wm protocol $w(findDialog) WM_DELETE_WINDOW \
  1356.                 [list wm withdraw $w(findDialog)]
  1357.  
  1358.         wm withdraw $w(findDialog)
  1359.         update idletasks
  1360.  
  1361.         frame $w(findDialog).content -bd 2 -relief groove
  1362.         pack $w(findDialog).content -side top -fill both -expand y \
  1363.                 -padx 5 -pady 5
  1364.  
  1365.         frame $w(findDialog).buttons
  1366.         pack $w(findDialog).buttons -side bottom -fill x -expand n
  1367.  
  1368.         button $w(findDialog).buttons.doit -text "Find Next" -command do-find
  1369.         button $w(findDialog).buttons.dismiss \
  1370.                 -text "Dismiss" \
  1371.                 -command "wm withdraw $w(findDialog)"
  1372.         pack $w(findDialog).buttons.dismiss -side right -pady 5 -padx 5
  1373.         pack $w(findDialog).buttons.doit -side right -pady 5 -padx 1
  1374.  
  1375.         set ff $w(findDialog).content.findFrame
  1376.         frame $ff -height 100 -bd 2 -relief flat
  1377.         pack $ff -side top -fill x -expand n -padx 5 -pady 5
  1378.  
  1379.         label $ff.label -text "Find what:" -underline 2
  1380.  
  1381.         entry $ff.entry -textvariable g(findString)
  1382.  
  1383.         checkbutton $ff.searchCase \
  1384.                 -text "Ignore Case" \
  1385.                 -offvalue 0 \
  1386.                 -onvalue 1 \
  1387.                 -indicatoron true \
  1388.                 -variable g(findIgnoreCase)
  1389.  
  1390.         grid $ff.label -row 0 -column 0 -sticky e
  1391.         grid $ff.entry -row 0 -column 1 -sticky ew
  1392.         grid $ff.searchCase -row 0 -column 2 -sticky w
  1393.         grid columnconfigure $ff 0 -weight 0
  1394.         grid columnconfigure $ff 1 -weight 1
  1395.         grid columnconfigure $ff 2 -weight 0
  1396.  
  1397.         # we need this in other places...
  1398.         set w(findEntry) $ff.entry
  1399.  
  1400.         bind $ff.entry <Return> do-find
  1401.  
  1402.         set of $w(findDialog).content.optionsFrame
  1403.         frame $of -bd 2 -relief flat
  1404.         pack $of -side top -fill y -expand y -padx 10 -pady 10
  1405.  
  1406.         label $of.directionLabel -text "Search Direction:"  -anchor e
  1407.         radiobutton $of.directionForward \
  1408.                 -indicatoron true \
  1409.                 -text "Down" \
  1410.                 -value "-forward" \
  1411.                 -variable g(findDirection)
  1412.         radiobutton $of.directionBackward \
  1413.                 -text "Up" \
  1414.                 -value "-backward" \
  1415.                 -indicatoron true \
  1416.                 -variable g(findDirection)
  1417.  
  1418.  
  1419.         label $of.windowLabel -text "Window:" -anchor e
  1420.         radiobutton $of.windowLeft \
  1421.                 -indicatoron true \
  1422.                 -text "Left" \
  1423.                 -value $w(LeftText) \
  1424.                 -variable g(activeWindow)
  1425.         radiobutton $of.windowRight \
  1426.                 -indicatoron true \
  1427.                 -text "Right" \
  1428.                 -value $w(RightText) \
  1429.                 -variable g(activeWindow)
  1430.  
  1431.  
  1432.         label $of.searchLabel -text "Search Type:" -anchor e
  1433.         radiobutton $of.searchExact \
  1434.                 -indicatoron true \
  1435.                 -text "Exact" \
  1436.                 -value "-exact" \
  1437.                 -variable g(findType)
  1438.         radiobutton $of.searchRegexp \
  1439.                 -text "Regexp" \
  1440.                 -value "-regexp" \
  1441.                 -indicatoron true \
  1442.                 -variable g(findType)
  1443.  
  1444.         grid $of.directionLabel    -row 1 -column 0 -sticky w
  1445.         grid $of.directionForward  -row 1 -column 1 -sticky w
  1446.         grid $of.directionBackward -row 1 -column 2 -sticky w
  1447.  
  1448.         grid $of.windowLabel    -row 0 -column 0 -sticky w
  1449.         grid $of.windowLeft     -row 0 -column 1 -sticky w
  1450.         grid $of.windowRight    -row 0 -column 2 -sticky w
  1451.  
  1452.         grid $of.searchLabel    -row 2 -column 0 -sticky w
  1453.         grid $of.searchExact    -row 2 -column 1 -sticky w
  1454.         grid $of.searchRegexp   -row 2 -column 2 -sticky w
  1455.  
  1456.         grid columnconfigure $of 0 -weight 0
  1457.         grid columnconfigure $of 1 -weight 0
  1458.         grid columnconfigure $of 2 -weight 1
  1459.  
  1460.         set g(findDirection) "-forward"
  1461.         set g(findType) "-exact"
  1462.         set g(findIgnoreCase) 1
  1463.         set g(lastSearch) ""
  1464.         if {$g(activeWindow) == ""} {
  1465.             set g(activeWindow) [focus]
  1466.             if {$g(activeWindow) != $w(LeftText) && \
  1467.                     $g(activeWindow) != $w(RightText)} {
  1468.                 set g(activeWindow) $w(LeftText)
  1469.             }
  1470.         }
  1471.     }
  1472.  
  1473.     centerWindow $w(findDialog)
  1474.     wm deiconify $w(findDialog)
  1475.     after idle focus $w(findEntry)
  1476. }
  1477.  
  1478. ###############################################################################
  1479. # do the "Edit->Copy" functionality, by copying the current selection
  1480. # to the clipboard
  1481. ###############################################################################
  1482.  
  1483. proc do-copy {} {
  1484.     clipboard clear -displayof .
  1485.     # figure out which window has the selection...
  1486.     catch {
  1487.         clipboard append [selection get -displayof .]
  1488.     }
  1489. }
  1490.  
  1491. ###############################################################################
  1492. # search for the text in the find dialog
  1493. ###############################################################################
  1494.  
  1495. proc do-find {} {
  1496.     global g
  1497.     global w
  1498.  
  1499.     if {![winfo exists $w(findDialog)] || ![winfo ismapped $w(findDialog)]} {
  1500.         show-find
  1501.         return
  1502.     }
  1503.  
  1504.     set win $g(activeWindow)
  1505.     if {$win == ""} {set win $w(LeftText)}
  1506.     if {$g(lastSearch) != ""} {
  1507.         if {$g(findDirection) == "-forward"} {
  1508.             set start [$win index "insert +1c"]
  1509.         } else {
  1510.             set start insert
  1511.         }
  1512.     } else {
  1513.         set start 1.0
  1514.     }
  1515.  
  1516.     if {$g(findIgnoreCase)} {
  1517.         set result [$win search $g(findDirection) $g(findType) -nocase -- \
  1518.             $g(findString) $start]
  1519.     } else {
  1520.         set result [$win search $g(findDirection) $g(findType) -- \
  1521.             $g(findString) $start]
  1522.     }
  1523.     if {[string length $result] > 0} {
  1524.         # if this is a regular expression search, get the whole line and try
  1525.         # to figure out exactly what matched; otherwise we know we must
  1526.         # have matched the whole string...
  1527.         if {$g(findType) == "-regexp"} {
  1528.             set line [$win get $result "$result lineend"]
  1529.             regexp $g(findString) $line matchVar
  1530.             set length [string length $matchVar]
  1531.         } else {
  1532.             set length [string length $g(findString)]
  1533.         }
  1534.         set g(lastSearch) $result
  1535.         $win mark set insert $result
  1536.         $win tag remove sel 1.0 end
  1537.         $win tag add sel $result "$result + ${length}c"
  1538.         $win see $result
  1539.         focus $win
  1540.         # should I somehow snap to the nearest diff? Probably not...
  1541.     } else {
  1542.         bell;
  1543.     }
  1544. }
  1545. proc build-menubar {} {
  1546.     global tooltip
  1547.     global w
  1548.     global g
  1549.  
  1550.     if {$g(nativeMenus)} {
  1551.         menu $w(menubar)
  1552.     } else {
  1553.         frame $w(menubar) -bd 2 -relief flat
  1554.     }
  1555.  
  1556.     # this is just temporary shorthand ...
  1557.     set menubar $w(menubar)
  1558.  
  1559.  
  1560.     # First, the menu buttons...
  1561.  
  1562.     if {$g(nativeMenus)} {
  1563.  
  1564.         set fileMenu   $w(menubar).file
  1565.         set viewMenu   $w(menubar).view
  1566.         set helpMenu   $w(menubar).help
  1567.         set editMenu   $w(menubar).edit
  1568.         set mergeMenu   $w(menubar).window
  1569.  
  1570.         $w(menubar) add cascade -label "File" -menu $fileMenu -underline 0
  1571.         $w(menubar) add cascade -label "Edit" -menu $editMenu -underline 0
  1572.         $w(menubar) add cascade -label "View" -menu $viewMenu -underline 0
  1573.         $w(menubar) add cascade -label "Merge" -menu $mergeMenu -underline 0
  1574.         $w(menubar) add cascade -label "Help" -menu $helpMenu -underline 0
  1575.  
  1576.     } else {
  1577.         # these are shorthand used only in this routine...
  1578.         set fileButton $menubar.fileButton
  1579.         set viewButton $menubar.viewButton
  1580.         set helpButton $menubar.helpButton
  1581.         set editButton $menubar.editButton
  1582.         set mergeButton $menubar.mergeButton
  1583.  
  1584.         set fileMenu   $fileButton.file
  1585.         set viewMenu   $viewButton.view
  1586.         set helpMenu   $helpButton.help
  1587.         set editMenu   $editButton.edit
  1588.         set mergeMenu $mergeButton.window
  1589.  
  1590.         menubutton $fileButton -text "File" -menu $fileMenu -underline 0
  1591.         menubutton $editButton -text "Edit" -menu $editMenu -underline 0
  1592.         menubutton $viewButton -text "View" -menu $viewMenu -underline 0
  1593.         menubutton $helpButton -text "Help" -menu $helpMenu -underline 0
  1594.         menubutton $mergeButton -text "Merge" -menu $mergeMenu -underline 0
  1595.  
  1596.         pack $fileButton $editButton $viewButton $mergeButton \
  1597.                 -side left -fill none -expand n
  1598.         if {$::tcl_platform(platform) == "windows"} {
  1599.             pack $helpButton -side left -fill none -expand n
  1600.         } else {
  1601.             pack $helpButton -side right -fill none -expand n
  1602.         }
  1603.     }
  1604.  
  1605.     # these, however, are used in other places..
  1606.     set w(fileMenu) $fileMenu
  1607.     set w(viewMenu) $viewMenu
  1608.     set w(helpMenu) $helpMenu
  1609.     set w(editMenu) $editMenu
  1610.     set w(mergeMenu) $mergeMenu
  1611.  
  1612.     # Now, the menus...
  1613.  
  1614.     # File menu...
  1615.     menu $fileMenu
  1616.     $fileMenu add command \
  1617.             -label "New..." \
  1618.             -underline 0 \
  1619.             -command [list do-new-diff]
  1620.     $fileMenu add separator
  1621.     $fileMenu add command \
  1622.             -label "Recompute Diffs" \
  1623.             -underline 0 \
  1624.             -command recompute-diff
  1625.     $fileMenu add command \
  1626.             -label "Write Report..." \
  1627.             -command [list write-report popup]
  1628.     $fileMenu add separator
  1629.     $fileMenu add command \
  1630.             -label "Exit" \
  1631.             -underline 1 \
  1632.             -command do-exit
  1633.  
  1634.     set "g(tooltip,Exit)" "Exit $g(name)"
  1635.     set "g(tooltip,Recompute Diffs)" \
  1636.             "Recompute and redisplay the difference records."
  1637.     set "g(tooltip,Write Report...)" \
  1638.             "Write the diff records to a file"
  1639.  
  1640.     # Edit menu...  If you change, add or remove labels, be sure and
  1641.     # update the tooltips.
  1642.     menu $editMenu
  1643.     $editMenu add command -label "Copy" -underline 0 -command do-copy
  1644.     $editMenu add separator
  1645.     $editMenu add command -label "Find..." -underline 0 -command show-find
  1646.     $editMenu add separator
  1647.     $editMenu add command -label "Edit File 1" \
  1648.         -command {global g w; set g(activeWindow) $w(LeftText) ; do-edit}
  1649.     $editMenu add command -label "Edit File 2" \
  1650.         -command {global g w; set g(activeWindow) $w(RightText) ; do-edit}
  1651.     $editMenu add separator
  1652.     $editMenu add command \
  1653.             -label "Preferences..." \
  1654.             -underline 3 \
  1655.             -command customize
  1656.  
  1657.     set "g(tooltip,Copy)"    \
  1658.             "Copy the currently selected text to the clipboard."
  1659.     set "g(tooltip,Find...)" \
  1660.             "Pop up a dialog to search for a string within either file."
  1661.     set "g(tooltip,Edit File 1)" \
  1662.             "Launch an editor on the file on the left side of the window."
  1663.     set "g(tooltip,Edit File 2)" \
  1664.             "Launch an editor on the file on the right side of the window."
  1665.     set "g(tooltip,Preferences...)"  \
  1666.             "Pop up a window to customize $g(name)."
  1667.  
  1668.     # View menu...  If you change, add or remove labels, be sure and
  1669.     # update the tooltips.
  1670.     menu $viewMenu
  1671.     $viewMenu add checkbutton \
  1672.             -label "Show Line Numbers" \
  1673.             -underline 12 \
  1674.             -variable opts(showln) \
  1675.             -command do-show-linenumbers
  1676.  
  1677.     $viewMenu add checkbutton \
  1678.             -label "Show Change Bars" \
  1679.             -underline 0 \
  1680.             -variable opts(showcbs) \
  1681.             -command do-show-changebars
  1682.  
  1683.     $viewMenu add checkbutton \
  1684.             -label "Show Diff Map" \
  1685.             -underline 0 \
  1686.             -variable opts(showmap) \
  1687.             -command do-show-map
  1688.  
  1689.     $viewMenu add separator
  1690.  
  1691.     $viewMenu add checkbutton \
  1692.             -label "Synchronize Scrollbars" \
  1693.             -underline 0 \
  1694.             -variable opts(syncscroll)
  1695.     $viewMenu add checkbutton -label "Auto Center" \
  1696.             -underline 0 \
  1697.             -variable opts(autocenter) \
  1698.             -command {if {$opts(autocenter)} {center}}
  1699.     $viewMenu add checkbutton -label "Auto Select" \
  1700.             -underline 1 \
  1701.             -variable opts(autoselect)
  1702.  
  1703.     $viewMenu add separator
  1704.  
  1705.     $viewMenu add command \
  1706.             -label "First Diff"  \
  1707.             -underline 0 \
  1708.             -command { move first } \
  1709.             -accelerator "F"
  1710.     $viewMenu add command \
  1711.             -label "Previous Diff"   \
  1712.             -underline 0 \
  1713.             -command { move -1 } \
  1714.             -accelerator "P"
  1715.     $viewMenu add command \
  1716.             -label "Center Current Diff" \
  1717.             -underline 0 \
  1718.             -command { center } \
  1719.             -accelerator "C"
  1720.     $viewMenu add command \
  1721.             -label "Next Diff"   \
  1722.             -underline 0 \
  1723.             -command { move 1 } \
  1724.             -accelerator "N"
  1725.     $viewMenu add command \
  1726.             -label "Last Diff"   \
  1727.             -underline 0 \
  1728.             -command { move last } \
  1729.             -accelerator "L"
  1730.  
  1731.     set "g(tooltip,Show Change Bars)" \
  1732.             "If set, show the changebar column for each line of each file"
  1733.     set "g(tooltip,Show Line Numbers)"  \
  1734.             "If set, show line numbers beside each line of each file"
  1735.     set "g(tooltip,Synchronize Scrollbars)"  \
  1736.             "If set, scrolling either window will scroll both windows."
  1737.     set "g(tooltip,Diff Map)"  \
  1738.             "If set, display the graphical \"Difference Map\" in the center of the display."
  1739.     set "g(tooltip,Auto Select)" \
  1740.             "If set, automatically selects the nearest diff record while scrolling"
  1741.     set "g(tooltip,Auto Center)"  \
  1742.             "If set, moving to another diff record will center the diff on the screen."
  1743.     set "g(tooltip,Center Current Diff)"  \
  1744.             "Center the display around the current diff record."
  1745.     set "g(tooltip,First Diff)"  \
  1746.             "Go to the first difference."
  1747.     set "g(tooltip,Last Diff)"   \
  1748.             "Go to the last difference."
  1749.     set "g(tooltip,Previous Diff)"  \
  1750.             "Go to the diff record just prior to the current diff record."
  1751.     set "g(tooltip,Next Diff)"  \
  1752.             "Go to the diff record just after the current diff record."
  1753.  
  1754.     # Merge menu. If you change, add or remove labels, be sure and
  1755.     # update the tooltips.
  1756.     menu $mergeMenu
  1757.     $mergeMenu add checkbutton \
  1758.             -label "Show Merge Window" \
  1759.             -underline 9 \
  1760.             -variable g(showmerge) \
  1761.             -command do-show-merge
  1762.     $mergeMenu add command -label "Write Merge File" -underline 6 \
  1763.             -command popup-merge
  1764.     set "g(tooltip,Show Merge Window)"  \
  1765.             "Pops up a window showing the current merge results."
  1766.     set "g(tooltip,Write Merge File)"  \
  1767.             "Write the merge file to disk. You will be prompted for a filename."
  1768.  
  1769.     # Help menu. If you change, add or remove labels, be sure and
  1770.     # update the tooltips.
  1771.     menu $helpMenu
  1772.     $helpMenu add command -label "On GUI" -underline 3 -command do-help
  1773.     $helpMenu add command -label "On Command Line" -underline 3 -command do-usage
  1774.     $helpMenu add command -label "On Preferences" -underline 3 -command do-help-preferences
  1775.     $helpMenu add separator
  1776.     $helpMenu add command -label "About $g(name)" -underline 0 -command do-about
  1777.  
  1778.     bind $fileMenu  <<MenuSelect>> {showTooltip menu %W}
  1779.     bind $editMenu  <<MenuSelect>> {showTooltip menu %W}
  1780.     bind $viewMenu  <<MenuSelect>> {showTooltip menu %W}
  1781.     bind $mergeMenu <<MenuSelect>> {showTooltip menu %W}
  1782.     bind $helpMenu  <<MenuSelect>> {showTooltip menu %W}
  1783.  
  1784.     set "g(tooltip,On Preferences)" \
  1785.             "Show help on the user-settable preferences"
  1786.     set "g(tooltip,On GUI)"  \
  1787.             "Show help on how to use the Graphical User Interface"
  1788.     set "g(tooltip,On Command Line)"  \
  1789.             "Show help on the command line arguments"
  1790.     set "g(tooltip,About $g(name))"  \
  1791.             "Show information about this application"
  1792. }
  1793.  
  1794. proc showTooltip {which w} {
  1795.     global tooltip
  1796.     global g
  1797.     switch $which {
  1798.         menu {
  1799.             if {[catch {$w entrycget active -label} label]} {
  1800.                 set label ""
  1801.             }
  1802.             if {[info exists g(tooltip,$label)]} {
  1803.                 set g(statusInfo) $g(tooltip,$label)
  1804.             } else {
  1805.                 set g(statusInfo) $label
  1806.             }
  1807.             update idletasks
  1808.         }
  1809.  
  1810.         button {
  1811.             if {[info exists g(tooltip,$w)]} {
  1812.                 set g(statusInfo) $g(tooltip,$w)
  1813.             } else {
  1814.                 set g(statusInfo) ""
  1815.             }
  1816.             update idletasks
  1817.         }
  1818.     }
  1819. }
  1820.  
  1821. proc build-toolbar {} {
  1822.     global w g
  1823.  
  1824.     frame $w(toolbar) -bd 2 -relief groove
  1825.     set toolbar $w(toolbar)
  1826.  
  1827.     # these are shorthand used only in this routine...
  1828.     set find            $toolbar.find
  1829.     set prevDiff        $toolbar.prev
  1830.     set firstDiff       $toolbar.first
  1831.     set lastDiff        $toolbar.last
  1832.     set nextDiff        $toolbar.next
  1833.     set centerDiffs     $toolbar.center
  1834.     set mergeChoice1    $toolbar.m1
  1835.     set mergeChoice2    $toolbar.m2
  1836.     set mergeChoiceLbl  $toolbar.mlabel
  1837.     set currentPos      $toolbar.cp
  1838.     set combo           $toolbar.combo
  1839.  
  1840.     # these, however, are used in other places..
  1841.     set w(find)             $find
  1842.     set w(prevDiff)         $prevDiff
  1843.     set w(firstDiff)        $firstDiff
  1844.     set w(lastDiff)         $lastDiff
  1845.     set w(nextDiff)         $nextDiff
  1846.     set w(centerDiffs)      $centerDiffs
  1847.     set w(mergeChoice1)     $mergeChoice1
  1848.     set w(mergeChoice2)     $mergeChoice2
  1849.     set w(currentPos)       $currentPos
  1850.     set w(combo)            $combo
  1851.     set w(mergeChoiceLabel) $mergeChoiceLbl
  1852.  
  1853.     label $currentPos -textvariable g(pos)
  1854.  
  1855.     # some separators we'll use in other places
  1856.     toolsep $toolbar.sep1
  1857.     toolsep $toolbar.sep2
  1858.     toolsep $toolbar.sep3
  1859.     toolsep $toolbar.sep4
  1860.     toolsep $toolbar.sep5
  1861.  
  1862.     # find...
  1863.     toolbutton $find -text "Find" -width 5 -command do-find -bd 1
  1864.  
  1865.     # navigation widgets
  1866.     toolbutton $prevDiff  -text "Prev"  -width 5 -command [list move -1] -bd 1
  1867.     toolbutton $nextDiff  -text "Next"  -width 5 -command [list move 1] -bd 1
  1868.     toolbutton $firstDiff -text "First" -width 5 -command [list move first] -bd 1
  1869.     toolbutton $lastDiff  -text "Last" -width 5 -command [list move last] -bd 1
  1870.     toolbutton $centerDiffs -text "Center" -width 5 -command center -bd 1
  1871.  
  1872.     ::combobox::combobox $combo -editable false -width 30 -command moveTo
  1873.  
  1874.     # the merge widgets
  1875.     radiobutton $mergeChoice2 \
  1876.             -indicatoron true \
  1877.             -text Right \
  1878.             -value 2 \
  1879.             -variable g(toggle) \
  1880.             -command [list do-merge-choice 2] \
  1881.             -takefocus 0
  1882.     radiobutton $mergeChoice1 \
  1883.             -indicatoron true \
  1884.             -text Left \
  1885.             -value 1 \
  1886.             -variable g(toggle) \
  1887.             -command [list do-merge-choice 1] \
  1888.             -takefocus 0
  1889.  
  1890.     # this is gross. We want the label next to the radiobuttons to
  1891.     # be disabled if the radiobuttons are disabled. But, labels can't
  1892.     # be disabled, so we'll use a "dead" button
  1893.     button $mergeChoiceLbl -text "Merge Choice:" -borderwidth 0 -command {} \
  1894.             -highlightthickness 0
  1895.  
  1896.     pack $combo -side left -padx 2
  1897.     pack $toolbar.sep1 -side left -fill y -pady 2 -padx 2
  1898.     pack $find -side left -padx 2
  1899.     pack $toolbar.sep2 -side left -fill y -pady 2 -padx 2
  1900.     pack $firstDiff $prevDiff $nextDiff $lastDiff \
  1901.             -side left  -pady 2 -padx 0
  1902.     pack $toolbar.sep3 -side left -fill y -pady 2 -padx 2
  1903.     pack $centerDiffs -side left  -pady 2 -padx 0
  1904.     pack $toolbar.sep5 -side left -fill y -pady 2 -padx 2
  1905.     pack $mergeChoiceLbl $mergeChoice1 $mergeChoice2  -side left -padx 2
  1906.  
  1907.     # these bindings provide pseudo-tooltips. Note that if some menu
  1908.     # items change, these references need to be updated... Also, we
  1909.     # assume the menubar tooltips have already been defined....
  1910.     set g(tooltip,$combo)       "Shows current difference record; allows you to go to a specific difference."
  1911.     set g(tooltip,$prevDiff)    $g(tooltip,Previous Diff);
  1912.     set g(tooltip,$nextDiff)    $g(tooltip,Next Diff);
  1913.     set g(tooltip,$firstDiff)   $g(tooltip,First Diff);
  1914.     set g(tooltip,$lastDiff)    $g(tooltip,Last Diff);
  1915.     set g(tooltip,$centerDiffs) $g(tooltip,Center Current Diff);
  1916.     set g(tooltip,$find)        $g(tooltip,Find...);
  1917.     set g(tooltip,$mergeChoice1) \
  1918.             "select the diff record on the left for merging"
  1919.     set g(tooltip,$mergeChoice2) \
  1920.             "select the diff record on the right for merging"
  1921.  
  1922.     # the toolbuttons have support for tooltips, the combobox and
  1923.     # radiobuttons do not. But, we can use the same callback.
  1924.     foreach widget [list $combo $mergeChoice1 $mergeChoice2] {
  1925.         bind $widget <Enter>    +[list toolbutton:handleEvent <Enter> %W 0]
  1926.         bind $widget <Leave>    +[list toolbutton:handleEvent <Leave> %W 0]
  1927.         bind $widget <FocusIn>  +[list toolbutton:handleEvent <FocusIn> %W 0]
  1928.         bind $widget <FocusOut> +[list toolbutton:handleEvent <FocusOut> %W 0]
  1929.     }
  1930. }
  1931.  
  1932. proc build-status {} {
  1933.     global w
  1934.     global g
  1935.  
  1936.     frame $w(status)  -bd 1 -relief flat
  1937.  
  1938.     set w(statusLabel) $w(status).label
  1939.     set w(statusCurrent) $w(status).current
  1940.  
  1941.     label $w(statusCurrent) \
  1942.             -textvariable g(statusCurrent) \
  1943.             -anchor e \
  1944.             -width 14 \
  1945.             -borderwidth 1 \
  1946.             -relief sunken \
  1947.             -padx 4 \
  1948.             -pady 2
  1949.     label $w(statusLabel) \
  1950.             -textvariable g(statusInfo) \
  1951.             -anchor w \
  1952.             -width 1 \
  1953.             -borderwidth 1 \
  1954.             -relief sunken \
  1955.             -pady 2
  1956.     pack $w(statusCurrent) -side right -fill y -expand n
  1957.     pack $w(statusLabel) -side left -fill both -expand y
  1958. }
  1959.  
  1960. ###############################################################################
  1961. # handles events over the map
  1962. ###############################################################################
  1963. proc handleMapEvent {event y} {
  1964.     global opts
  1965.     global w
  1966.     global g
  1967.  
  1968.     switch $event {
  1969.  
  1970.         B1-Press {
  1971.             set ty1 [lindex $g(thumbBbox) 1]
  1972.             set ty2 [lindex $g(thumbBbox) 3]
  1973.             if {$y >= $ty1 && $y <= $ty2} {
  1974.                 set g(mapScrolling) 1
  1975.             }
  1976.         }
  1977.  
  1978.         B1-Motion {
  1979.             if {[info exists g(mapScrolling)]} {
  1980.                 map-seek $y
  1981.             }
  1982.         }
  1983.  
  1984.         B1-Release {
  1985.             show-info ""
  1986.             set ty1 [lindex $g(thumbBbox) 1]
  1987.             set ty2 [lindex $g(thumbBbox) 3]
  1988.             # if we release over the trough (actually, *not* over the thumb),
  1989.             # just scroll by the size of the thumb
  1990.             if {$y < $ty1 || $y > $ty2} {
  1991.                 if {$y < $ty1} {
  1992.                     # if vertical scrollbar syncing is turned on,
  1993.                     # all the other windows should toe the line
  1994.                     # appropriately...
  1995.                     $w(RightText) yview scroll -1 pages
  1996.                 } else {
  1997.                     $w(RightText) yview scroll 1 pages
  1998.                 }
  1999.  
  2000.             } else {
  2001.                 # do nothing
  2002.             }
  2003.  
  2004.             catch {unset g(mapScrolling)}
  2005.         }
  2006.     }
  2007. }
  2008.  
  2009. # makes a toolbar "separator"
  2010. proc toolsep {w} {
  2011.     label $w -image [image create photo] -highlightthickness 0 -bd 1 \
  2012.             -width 0 -relief groove
  2013.     return $w
  2014. }
  2015.  
  2016. proc toolbutton {w args} {
  2017.     global tcl_platform
  2018.     global opts
  2019.  
  2020.     # create the button
  2021.     eval button $w $args
  2022.  
  2023.     # add minimal tooltip-like support
  2024.     bind $w <Enter>    [list toolbutton:handleEvent <Enter> %W]
  2025.     bind $w <Leave>    [list toolbutton:handleEvent <Leave> %W]
  2026.     bind $w <FocusIn>  [list toolbutton:handleEvent <FocusIn> %W]
  2027.     bind $w <FocusOut> [list toolbutton:handleEvent <FocusOut> %W]
  2028.  
  2029.     # give a taste of the MS Windows "look and feel"
  2030.     if {$opts(fancyButtons)} {
  2031.         $w configure -relief flat
  2032.     }
  2033.  
  2034.     return $w
  2035. }
  2036.  
  2037. # handle events in our fancy toolbuttons...
  2038. proc toolbutton:handleEvent {event w {isToolbutton 1}} {
  2039.     global g
  2040.     global opts
  2041.  
  2042.     switch $event {
  2043.         "<Enter>" {
  2044.             showTooltip button $w
  2045.             if {$opts(fancyButtons) && $isToolbutton && \
  2046.                 [$w cget -state] == "normal"} {
  2047.                 $w configure -relief raised
  2048.             }
  2049.         }
  2050.         "<Leave>" {
  2051.             set g(statusInfo) ""
  2052.             if {$opts(fancyButtons) && $isToolbutton} {
  2053.                 $w configure -relief flat
  2054.             }
  2055.         }
  2056.         "<FocusIn>" {
  2057.             showTooltip button $w
  2058.             if {$opts(fancyButtons) && $isToolbutton && \
  2059.                 [$w cget -state] == "normal"} {
  2060.                 $w configure -relief raised
  2061.             }
  2062.         }
  2063.         "<FocusOut>" {
  2064.             set g(statusInfo) ""
  2065.             if {$opts(fancyButtons) && $isToolbutton} {
  2066.                 $w configure -relief flat
  2067.             }
  2068.         }
  2069.     }
  2070. }
  2071.  
  2072. ###############################################################################
  2073. # move the map thumb to correspond to current shown merge...
  2074. ###############################################################################
  2075. proc map-move-thumb {y1 y2} {
  2076.     global g
  2077.     global finfo
  2078.     global w
  2079.  
  2080.     set thumbheight [expr {($y2 - $y1) * $g(mapheight)}]
  2081.     if {$thumbheight < $g(thumbMinHeight)} {
  2082.         set thumbheight $g(thumbMinHeight)
  2083.     }
  2084.  
  2085.     if {![info exists g(mapwidth)]} {set g(mapwidth) 0}
  2086.     set x1 1
  2087.     set x2 [expr {$g(mapwidth) - 3}]
  2088.  
  2089.     # why -2? it's the thickness of our border...
  2090.     set y1 [expr {int(($y1 * $g(mapheight)) - 2)}]
  2091.     if {$y1 < 0} {set y1 0}
  2092.  
  2093.     set y2 [expr $y1 + $thumbheight]
  2094.     if {$y2 > $g(mapheight)} {
  2095.         set y2 $g(mapheight)
  2096.         set y1 [expr $y2 - $thumbheight]
  2097.     }
  2098.  
  2099.     set dx1 [expr {$x1 + 1}]
  2100.     set dx2 [expr {$x2 - 1}]
  2101.     set dy1 [expr {$y1 + 1}]
  2102.     set dy2 [expr {$y2 - 1}]
  2103.  
  2104.     $w(mapCanvas) coords thumbUL \
  2105.             $x1 $y2 $x1 $y1 $x2 $y1 $dx2 $dy1 $dx1 $dy1 $dx1 $dy2
  2106.     $w(mapCanvas) coords thumbLR \
  2107.             $dx1 $y2 $x2 $y2 $x2 $dy1 $dx2 $dy1 $dx2 $dy2 $dx1 $dy2
  2108.  
  2109.     set g(thumbBbox) [list $x1 $y1 $x2 $y2]
  2110.     set g(thumbHeight) $thumbheight
  2111. }
  2112.  
  2113. ###############################################################################
  2114. # Bind keys for Next, Prev, Center, Merge choices 1 and 2
  2115. ###############################################################################
  2116. proc common-navigation {args} {
  2117.     global w
  2118.  
  2119.     bind . <Control-f> do-find
  2120.  
  2121.     foreach widget $args {
  2122.         # this effectively disables the widget, without having to
  2123.         # resort to actually disabling the widget (the latter which
  2124.         # has some annoying side effects). What we really want is to
  2125.         # only disable keys that get inserted, but that's difficult
  2126.         # to do, and this works almost as well...
  2127.         bind $widget <KeyPress> {break};
  2128.         bind $widget <<Paste>> {break};
  2129.  
  2130.         # ... but now we need to restore some navigation key bindings
  2131.         # which got lost because we disable all keys.
  2132.         foreach event [list Next Prior Up Down Left Right Home End] {
  2133.             foreach modifier [list {} Shift Control Shift-Control] {
  2134.                 bind $widget "<${modifier}${event}>" \
  2135.                         [bind Text "<${modifier}${event}>"]
  2136.             }
  2137.         }
  2138.  
  2139.         # these bindings allow control-f, tab and shift-tab to work
  2140.         # in spite of the fact we bound Any-KeyPress to a null action
  2141.         bind $widget <Control-f> continue;
  2142.         bind $widget <Tab> continue;
  2143.         bind $widget <Shift-Tab> continue;
  2144.  
  2145.         bind $widget <c> "$w(centerDiffs) invoke; break"
  2146.         bind $widget <n> "$w(nextDiff) invoke; break"
  2147.         bind $widget <p> "$w(prevDiff) invoke; break"
  2148.         bind $widget <f> "$w(firstDiff) invoke; break"
  2149.         bind $widget <l> "$w(lastDiff) invoke; break"
  2150.         bind $widget <Return> "moveNearest $widget mark insert;break"
  2151.  
  2152.         # these bindings keep Alt- modified keys from triggering
  2153.         # the above actions. This way, any Alt combinations that
  2154.         # should open a menu will...
  2155.         foreach key [list c n p f l] {
  2156.             bind $widget <Alt-$key> {continue}
  2157.         }
  2158.  
  2159.         bind $widget <Double-1> "moveNearest $widget xy %x %y; break"
  2160.  
  2161.         bind $widget <Key-1> "$w(mergeChoice1) invoke; break"
  2162.         bind $widget <Key-2> "$w(mergeChoice2) invoke; break"
  2163.     }
  2164. }
  2165.  
  2166. ###############################################################################
  2167. # Customize the display (among other things).
  2168. ###############################################################################
  2169.  
  2170. proc customize {} {
  2171.     global pref
  2172.     global g
  2173.     global w
  2174.     global opts
  2175.     global tmpopts
  2176.  
  2177.     catch {destroy $w(preferences)}
  2178.     toplevel $w(preferences)
  2179.  
  2180.     wm title $w(preferences) "$g(name) Preferences"
  2181.     wm transient $w(preferences) .
  2182.     wm group $w(preferences) .
  2183.  
  2184.     wm withdraw $w(preferences)
  2185.  
  2186.     # the button frame...
  2187.     frame $w(preferences).buttons -bd 0
  2188.     button $w(preferences).buttons.dismiss \
  2189.             -width 8 \
  2190.             -text "Dismiss" \
  2191.             -command {destroy $w(preferences)}
  2192.     button $w(preferences).buttons.apply \
  2193.             -width 8 \
  2194.             -text "Apply" \
  2195.             -command apply
  2196.     button $w(preferences).buttons.save \
  2197.             -width 8 \
  2198.             -text "Save" \
  2199.             -command save
  2200.  
  2201.     button $w(preferences).buttons.help \
  2202.             -width 8 \
  2203.             -text "Help" \
  2204.             -command do-help-preferences
  2205.  
  2206.     pack $w(preferences).buttons -side bottom -fill x
  2207.     pack $w(preferences).buttons.dismiss -side right -padx 10 -pady 5
  2208.     pack $w(preferences).buttons.help    -side right -padx 10 -pady 5
  2209.     pack $w(preferences).buttons.save    -side right -padx 1  -pady 5
  2210.     pack $w(preferences).buttons.apply   -side right -padx 1  -pady 5
  2211.  
  2212.     # a series of checkbuttons to act as a poor mans notebook tab
  2213.     frame $w(preferences).notebook -bd 0
  2214.     pack $w(preferences).notebook -side top -fill x -pady 4
  2215.     set pagelist {}
  2216.     foreach page [list General Display Appearance] {
  2217.         set frame $w(preferences).f$page
  2218.         lappend pagelist $frame
  2219.         set rb $w(preferences).notebook.f$page
  2220.         radiobutton $rb \
  2221.                 -command "customize-selectPage $frame" \
  2222.                 -variable g(prefPage) \
  2223.                 -value $frame \
  2224.                 -text $page \
  2225.                 -indicatoron false \
  2226.                 -width 10 \
  2227.                 -borderwidth 1
  2228.  
  2229.         pack $rb -side left
  2230.  
  2231.         frame $frame -bd 2 -relief groove -width 400 -height 300
  2232.     }
  2233.     set g(prefPage) $w(preferences).fGeneral
  2234.  
  2235.     # make sure our labels are defined
  2236.     customize-initLabels
  2237.  
  2238.     # General
  2239.     set count 0
  2240.     set frame $w(preferences).fGeneral
  2241.     foreach key {diffcmd tmpdir editor geometry} {
  2242.         label $frame.l$count -text "$pref($key): " -anchor w
  2243.         set tmpopts($key) $opts($key)
  2244.         entry $frame.e$count \
  2245.                 -textvariable tmpopts($key) -width 50 \
  2246.                 -bd 2 -relief sunken
  2247.  
  2248.         grid $frame.l$count -row $count -column 0 -sticky w -padx 5 -pady 2
  2249.         grid $frame.e$count -row $count -column 1 -sticky ew -padx 5 -pady 2
  2250.  
  2251.         incr count
  2252.     }
  2253.  
  2254.     # this is just for filler...
  2255.     label $frame.filler -text {}
  2256.     grid $frame.filler -row $count
  2257.     incr count
  2258.  
  2259.     foreach key {fancyButtons autocenter syncscroll autoselect} {
  2260.         label $frame.l$count -text "$pref($key): " -anchor w
  2261.         set tmpopts($key) $opts($key)
  2262.         checkbutton $frame.c$count \
  2263.                 -indicatoron true \
  2264.                 -text "$pref($key)" \
  2265.                 -justify left \
  2266.                 -onvalue 1 \
  2267.                 -offvalue 0 \
  2268.                 -variable tmpopts($key)
  2269.  
  2270.         set tmpopts($key) $opts($key)
  2271.  
  2272.         grid $frame.c$count -row $count -column 0 -sticky w -padx 5 \
  2273.                 -columnspan 2
  2274.  
  2275.         incr count
  2276.     }
  2277.  
  2278.     grid columnconfigure $frame 0 -weight 0
  2279.     grid columnconfigure $frame 1 -weight 1
  2280.  
  2281.     # this, in effect, adds a hidden row at the bottom which takes
  2282.     # up any extra room
  2283.  
  2284.     grid rowconfigure    $frame $count -weight 1
  2285.  
  2286.     # pack this window for a brief moment, and compute the window
  2287.     # size. We'll do this for each "page" and find the largest
  2288.     # size to be the size of the dialog
  2289.     pack $frame -side right -fill both -expand y
  2290.     update idletasks
  2291.     set maxwidth [winfo reqwidth $w(preferences)]
  2292.     set maxheight [winfo reqheight $w(preferences)]
  2293.     pack forget $frame
  2294.  
  2295.     # Appearance
  2296.     set frame $w(preferences).fAppearance
  2297.     set count 0
  2298.     foreach key {textopt difftag deltag instag chgtag currtag} {
  2299.         label $frame.l$count -text "$pref($key): " -anchor w
  2300.         set tmpopts($key) $opts($key)
  2301.         entry $frame.e$count \
  2302.                 -textvariable tmpopts($key) \
  2303.                 -bd 2 -relief sunken
  2304.  
  2305.         grid $frame.l$count -row $count -column 0 -sticky w  -padx 5 -pady 2
  2306.         grid $frame.e$count -row $count -column 1 -sticky ew -padx 5 -pady 2
  2307.  
  2308.         incr count
  2309.     }
  2310.     grid columnconfigure $frame 0 -weight 0
  2311.     grid columnconfigure $frame 1 -weight 1
  2312.  
  2313.     # this, in effect, adds a hidden row at the bottom which takes
  2314.     # up any extra room
  2315.  
  2316.     grid rowconfigure    $frame $count -weight 1
  2317.  
  2318.     pack $frame -side right -fill both -expand y
  2319.     update idletasks
  2320.     set maxwidth [max $maxwidth [winfo reqwidth $w(preferences)]]
  2321.     set maxheight [max $maxheight [winfo reqheight $w(preferences)]]
  2322.     pack forget $frame
  2323.  
  2324.     # Display
  2325.     set frame $w(preferences).fDisplay
  2326.     set row 0
  2327.  
  2328.     # Option fields
  2329.     # Note that the order of the list is used to determine
  2330.     # the layout. So, if you add something to the list pay
  2331.     # attention to how if affects things.
  2332.     #
  2333.     # an x means an empty column; a - means an empty row
  2334.     set col 0
  2335.     foreach key [list \
  2336.             showln       tagln      \
  2337.             showcbs      tagcbs     \
  2338.             showmap      colorcbs   \
  2339.             x            tagtext    \
  2340.             -                      ] {
  2341.  
  2342.         if {$key == "x"} {
  2343.             set col [expr {$col ? 0 : 1}]
  2344.             if {$col == 0} {incr row}
  2345.             continue
  2346.         }
  2347.  
  2348.         if {$key == "-"} {
  2349.             frame $frame.f${row} -bd 0 -height 4
  2350.             grid $frame.f${row} -row $row -column 0 -columnspan 2 \
  2351.                     -padx 20 -pady 4 -sticky nsew
  2352.             set col 1 ;# will force next column to zero and incr row
  2353.  
  2354.         } else {
  2355.  
  2356.             checkbutton $frame.c${row}${col} \
  2357.                     -indicatoron true \
  2358.                     -text "$pref($key)" \
  2359.                     -onvalue 1 \
  2360.                     -offvalue 0 \
  2361.                     -variable tmpopts($key)
  2362.  
  2363.             set tmpopts($key) $opts($key)
  2364.  
  2365.             grid $frame.c${row}$col -row $row -column $col -sticky w -padx 5
  2366.         }
  2367.  
  2368.         set col [expr {$col ? 0 : 1}]
  2369.         if {$col == 0} {incr row}
  2370.     }
  2371.  
  2372.     grid columnconfigure $frame 0 -weight 0
  2373.     grid columnconfigure $frame 1 -weight 0
  2374.     grid columnconfigure $frame 2 -weight 0
  2375.     grid columnconfigure $frame 3 -weight 0
  2376.     grid columnconfigure $frame 4 -weight 1
  2377.  
  2378.     # this, in effect, adds a hidden row at the bottom which takes
  2379.     # up any extra room
  2380.  
  2381.     grid rowconfigure    $frame $row -weight 1
  2382.  
  2383.     pack $frame -side right -fill both -expand y
  2384.     update idletasks
  2385.     set maxwidth [max $maxwidth [winfo reqwidth $w(preferences)]]
  2386.     set maxheight [max $maxheight [winfo reqheight $w(preferences)]]
  2387.     pack forget $frame
  2388.  
  2389.     customize-selectPage
  2390.  
  2391.     # compute a reasonable location for the window...
  2392.     centerWindow $w(preferences) [list $maxwidth $maxheight]
  2393.  
  2394.     wm deiconify $w(preferences)
  2395. }
  2396.  
  2397. proc customize-selectPage {{frame {}}} {
  2398.     global g w
  2399.  
  2400.     if {$frame == ""} {
  2401.         set frame $g(prefPage)
  2402.     }
  2403.  
  2404.     pack forget $w(preferences).fGeneral
  2405.     pack forget $w(preferences).fAppearance
  2406.     pack forget $w(preferences).fDisplay
  2407.     pack forget $w(preferences).fBehavior
  2408.     pack $frame -side right -fill both -expand y
  2409. }
  2410.  
  2411. ###############################################################################
  2412. # define the labels for the preferences. This is done outside of
  2413. # the customize proc since the labels are used in the help text.
  2414. ###############################################################################
  2415. proc customize-initLabels {} {
  2416.     global pref
  2417.  
  2418.     set pref(diffcmd)  {diff command}
  2419.     set pref(textopt)  {Text widget options}
  2420.     set pref(difftag)  {Tag options for diff regions}
  2421.     set pref(currtag)  {Tag options for the current diff region}
  2422.     set pref(deltag)   {Tag options for deleted diff region}
  2423.     set pref(instag)   {Tag options for inserted diff region}
  2424.     set pref(chgtag)   {Tag options for changed diff region}
  2425.     set pref(geometry) {Text window size}
  2426.     set pref(tmpdir)   {Directory for scratch files}
  2427.     set pref(editor)   {Program for editing files}
  2428.  
  2429.     set pref(fancyButtons) {Fancy toolbar buttons}
  2430.     set pref(showmap)    {Show graphical map of diffs}
  2431.     set pref(showln)     {Show line numbers}
  2432.     set pref(showcbs)    {Show change bars}
  2433.     set pref(autocenter) {Automatically center current diff region}
  2434.     set pref(syncscroll) {Synchronize scrollbars}
  2435.  
  2436.     set pref(colorcbs)   {Color change bars to match the diff map}
  2437.     set pref(tagtext)    {Highlight file contents}
  2438.     set pref(tagcbs)     {Highlight change bars}
  2439.     set pref(tagln)      {Highlight line numbers}
  2440.  
  2441.     set pref(autoselect) \
  2442.             "Automaticallly select the nearest diff region while scrolling"
  2443.  
  2444. }
  2445.  
  2446. ###############################################################################
  2447. # Apply customization changes.
  2448. ###############################################################################
  2449.  
  2450. proc apply {} {
  2451.     global opts
  2452.     global tmpopts
  2453.     global w
  2454.  
  2455.     if {! [file isdirectory $tmpopts(tmpdir)]} {
  2456.         do-error "Invalid temporary directory $tmpopts(tmpdir)"
  2457.     }
  2458.  
  2459.     if {[catch "$w(LeftText) configure $tmpopts(textopt)
  2460.                 $w(RightText) configure $tmpopts(textopt)"]} {
  2461.         do-error "Invalid settings for text widget: \n\n$tmpopts(textopt)"
  2462.         eval "$w(LeftText) configure $opts(textopt)"
  2463.         eval "$w(LeftInfo) configure $opts(textopt)"
  2464.         return
  2465.     }
  2466.  
  2467.     # the text options must be ok. Configure the other text widgets
  2468.     # similarly
  2469.     eval "$w(LeftCB)    configure $tmpopts(textopt)"
  2470.     eval "$w(LeftInfo)  configure $tmpopts(textopt)"
  2471.     eval "$w(RightCB)   configure $tmpopts(textopt)"
  2472.     eval "$w(RightInfo) configure $tmpopts(textopt)"
  2473.  
  2474.     if {$tmpopts(geometry) == "" || \
  2475.             [catch {scan $tmpopts(geometry) "%dx%d" width height} result]} {
  2476.         do-error "invalid geometry setting: $tmpopts(geometry)"
  2477.         return
  2478.     }
  2479.     if {[catch {$w(LeftText) configure -width $width -height $height} result]} {
  2480.         do-error "invalid geometry setting: $tmpopts(geometry)"
  2481.         return
  2482.     }
  2483.     $w(RightText) configure -width $width -height $height
  2484.  
  2485.  
  2486.     foreach tag {difftag currtag deltag instag chgtag} {
  2487.         foreach win [list $w(LeftText)  $w(LeftInfo)  $w(LeftCB) \
  2488.                           $w(RightText) $w(RightInfo) $w(RightCB)] {
  2489.             if {[catch "$win tag configure $tag $tmpopts($tag)"]} {
  2490.                 do-error "Invalid settings\n\n$tmpopts($tag)"
  2491.                 eval "$win tag configure $tag $opts($tag)"
  2492.                 return
  2493.             }
  2494.         }
  2495.     }
  2496.  
  2497.     # set opts to the values from tmpopts
  2498.     foreach key {diffcmd textopt difftag currtag deltag instag chgtag \
  2499.                  tmpdir editor showmap showln showcbs autocenter syncscroll \
  2500.                  tagln tagcbs tagtext autoselect \
  2501.                  geometry fancyButtons colorcbs} {
  2502.         set opts($key) $tmpopts($key)
  2503.     }
  2504.  
  2505.     # reconfigure the buttons, since "fancyButtons" may have changed
  2506.     foreach button [list prevDiff nextDiff firstDiff lastDiff \
  2507.             centerDiffs find] {
  2508.         if {$opts(fancyButtons)} {
  2509.             $w($button) configure -relief flat
  2510.         } else {
  2511.             $w($button) configure -relief raised
  2512.         }
  2513.     }
  2514.  
  2515.     # remark all the diff regions, show (or hide) the line numbers,
  2516.     # change bars and diff map, and we are done.
  2517.     remark-diffs
  2518.     do-show-linenumbers
  2519.     do-show-changebars
  2520.     do-show-map
  2521. }
  2522.  
  2523. ###############################################################################
  2524. # Save customization changes.
  2525. ###############################################################################
  2526.  
  2527. proc save {} {
  2528.     global g
  2529.     global tmpopts rcfile tcl_platform
  2530.     global pref
  2531.  
  2532.     if {[ file exists $rcfile ]} {
  2533.       file rename -force $rcfile "$rcfile~"
  2534.     }
  2535.  
  2536.     # Need to quote backslashes, replace single \ with double \\
  2537.     regsub -all {\\} $tmpopts(tmpdir) {\\\\} tmpdir
  2538.  
  2539.     set fid [open $rcfile w]
  2540.  
  2541.     # put the tkdiff version in the file. It might be handy later
  2542.     puts $fid "# This file was generated by $g(name) $g(version)"
  2543.     puts $fid "# [clock format [clock seconds]]\n"
  2544.     puts $fid "set prefsFileVersion {$g(version)}\n"
  2545.  
  2546.     # now, put all of the preferences in the file
  2547.     foreach key {diffcmd textopt difftag currtag deltag instag \
  2548.                  chgtag showmap showln showcbs autocenter syncscroll \
  2549.                  fancyButtons geometry editor colorcbs autoselect \
  2550.                  tagln tagcbs tagtext } {
  2551.         regsub "\n" $pref($key) "\n# " comment
  2552.         puts $fid "# $comment"
  2553.         puts $fid "set opts($key) {$tmpopts($key)}\n"
  2554.     }
  2555.  
  2556.     # Seems we can't use {$tmpdir} here or embedded \\ don't translate to \
  2557.  
  2558.     puts $fid "# $pref(tmpdir)"
  2559.     puts $fid "set opts(tmpdir) \"$tmpdir\"\n"
  2560.  
  2561.     close $fid
  2562.  
  2563.     if { $tcl_platform(platform) == "windows" } {
  2564.         file attribute $rcfile -hidden 1
  2565.     }
  2566. }
  2567.  
  2568. ###############################################################################
  2569. # Text has scrolled, update scrollbars and synchronize windows
  2570. ###############################################################################
  2571.  
  2572. proc hscroll-sync {id args} {
  2573.     global g opts
  2574.     global w
  2575.  
  2576.     # If ignore_event is true, we've already taken care of scrolling.
  2577.     # We're only interested in the first event.
  2578.     if {$g(ignore_hevent,$id)} {
  2579.         return
  2580.     }
  2581.  
  2582.     # Scrollbar sizes
  2583.     set size1 [expr {[lindex [$w(LeftText) xview] 1] - [lindex [$w(LeftText) xview] 0]}]
  2584.     set size2 [expr {[lindex [$w(RightText) xview] 1] - [lindex [$w(RightText) xview] 0]}]
  2585.  
  2586.     if {$opts(syncscroll) || $id == 1} {
  2587.         set start [lindex $args 0]
  2588.  
  2589.         if {$id != 1} {
  2590.             set start [expr {$start * $size2 / $size1}]
  2591.         }
  2592.         $w(LeftHSB) set $start [expr {$start + $size1}]
  2593.         $w(LeftText) xview moveto $start
  2594.         set g(ignore_hevent,1) 1
  2595.     }
  2596.     if {$opts(syncscroll) || $id == 2} {
  2597.         set start [lindex $args 0]
  2598.         if {$id != 2} {
  2599.             set start [expr {$start * $size1 / $size2}]
  2600.         }
  2601.         $w(RightHSB) set $start [expr {$start + $size2}]
  2602.         $w(RightText) xview moveto $start
  2603.         set g(ignore_hevent,2) 1
  2604.     }
  2605.  
  2606.     # This forces all the event handlers for the view alterations
  2607.     # above to trigger, and we lock out the recursive (redundant)
  2608.     # events using ignore_event.
  2609.     update idletasks
  2610.     # Restore to normal
  2611.     set g(ignore_hevent,1) 0
  2612.     set g(ignore_hevent,2) 0
  2613. }
  2614.  
  2615. ###############################################################################
  2616. # Text has scrolled, update scrollbars and synchronize windows
  2617. ###############################################################################
  2618.  
  2619. proc vscroll-sync {id y0 y1} {
  2620.     global g opts
  2621.     global w
  2622.  
  2623.     # we always want to update the scrollbars, since that is
  2624.     # the typical duty of the -yscrollcommand (which this proc
  2625.     # is bound to...)
  2626.     if {$opts(syncscroll) || $id == 1} {
  2627.         $w(LeftVSB) set $y0 $y1
  2628.     }
  2629.  
  2630.     if {$opts(syncscroll) || $id == 2} {
  2631.         $w(RightVSB) set $y0 $y1
  2632.     }
  2633.  
  2634.     # if syncing is disabled, we're done.
  2635.     if {[info exists g(disableSyncing)]} {
  2636.         return
  2637.     }
  2638.  
  2639.     # move the map's thumb
  2640.     map-move-thumb $y0 $y1
  2641.  
  2642.     if {$opts(syncscroll) || $id == 1} {
  2643.         $w(LeftText) yview moveto $y0
  2644.         $w(LeftInfo) yview moveto $y0
  2645.         $w(LeftCB)   yview moveto $y0
  2646.     }
  2647.  
  2648.     if {$opts(syncscroll) || $id == 2} {
  2649.         $w(RightText) yview moveto $y0
  2650.         $w(RightInfo) yview moveto $y0
  2651.         $w(RightCB)   yview moveto $y0
  2652.     }
  2653.  
  2654.     # Select nearest visible diff region
  2655.     if {$opts(syncscroll) && $opts(autoselect) && $g(count) > 0} {
  2656.         set winhalf [expr {[winfo height $w(RightText)] / 2}]
  2657.         set result [find-diff [expr {int([$w(RightText) index @1,$winhalf])}]]
  2658.         set i [lindex $result 0]
  2659.  
  2660.         # have we found a diff other than the current diff?
  2661.         if {$i != $g(pos)} {
  2662.             # Also, make sure the diff is visible. If not, we won't
  2663.             # change the current diff region...
  2664.             set topline [$w(RightText) index @0,0]
  2665.             set bottomline [$w(RightText) index @0,10000]
  2666.             foreach {line s1 e1 s2 e2 type} $g(scrdiff,$i) {}
  2667.             if {$s1 >= $topline && $s1 <= $bottomline} {
  2668.                 move $i 0 0
  2669.             }
  2670.         }
  2671.     }
  2672.  
  2673.     # This flushes all the pending calls to the -yscrollcommand
  2674.     # for each widget. by setting disableSyncing these events
  2675.     # will just get ignored, since by now the view should be
  2676.     # up to date.
  2677.     set g(disableSyncing) 1
  2678.     update idletasks
  2679.     unset g(disableSyncing)
  2680.  
  2681.  
  2682. }
  2683.  
  2684. ###############################################################################
  2685. # Make a miniature map of the diff regions
  2686. ###############################################################################
  2687.  
  2688. proc create-map {map mapwidth mapheight} {
  2689.     global g
  2690.     global w
  2691.  
  2692.     # Text widget always contains blank line at the end
  2693.     set lines [expr {double([$w(LeftText) index end]) - 2}]
  2694.     set factor [expr {$mapheight / $lines}]
  2695.  
  2696.     # We add some transparent stuff to make the map fill the canvas
  2697.     # in order to receive mouse events at the very bottom.
  2698.     $map blank
  2699.     $map put \#000 -to 0 $mapheight $mapwidth $mapheight
  2700.  
  2701.     # Line numbers start at 1, not at 0.
  2702.     for {set i 1} {$i <= $g(count)} {incr i} {
  2703. #        scan $g(scrdiff,$i) "%s %d %d %d %d %s" line s1 e1 s2 e2 type
  2704.         foreach {line s1 e1 s2 e2 type} $g(scrdiff,$i) {}
  2705.  
  2706.         set y [expr {int(($s2 - 1) * $factor) + $g(mapborder)}]
  2707.         set size [expr {round(($e2 - $s2 + 1) * $factor)}]
  2708.         if {$size < 1} {
  2709.             set size 1
  2710.         }
  2711.         switch $type {
  2712.             "d" { set color red1 }
  2713.             "a" { set color green }
  2714.             "c" { set color blue }
  2715.         }
  2716.  
  2717.         $map put $color -to 0 $y $mapwidth [expr {$y + $size}]
  2718.  
  2719.     }
  2720.  
  2721.     # let's draw a rectangle to simulate a scrollbar thumb. The size
  2722.     # isn't important since it will get resized when map-move-thumb
  2723.     # is called...
  2724.     $w(mapCanvas) create line 0 0 0 0 -tags thumbUL -fill white
  2725.     $w(mapCanvas) create line 1 1 1 1 -tags thumbLR -fill black
  2726.     $w(mapCanvas) raise thumb
  2727.  
  2728.     # now, move the thumb
  2729.     eval map-move-thumb [$w(LeftText) yview]
  2730.  
  2731. }
  2732.  
  2733. ###############################################################################
  2734. # Resize map to fit window size
  2735. ###############################################################################
  2736.  
  2737. proc map-resize {args} {
  2738.     global g opts
  2739.     global w
  2740.  
  2741.     set mapwidth  [winfo width $w(map)]
  2742.     set g(mapborder) [expr { [$w(map) cget -borderwidth] + \
  2743.             [$w(map) cget -highlightthickness]}]
  2744.     set mapheight [expr {[winfo height $w(map)] - $g(mapborder) * 2}]
  2745.  
  2746.     # We'll get a couple of "resize" events, so don't draw a map
  2747.     # unless we've got the diffs and the map size has changed
  2748.     if {$g(count) == 0 || $mapheight == $g(mapheight)} {
  2749.         return
  2750.     }
  2751.  
  2752.     # If we don't have a map and don't want one, don't make one
  2753.     if {$g(mapheight) == 0 && $opts(showmap) == 0} {
  2754.         return
  2755.     }
  2756.  
  2757.     # This seems to happen on Windows!? _After_ the map is drawn the first time
  2758.     # another event triggers and [winfo height $w(map)] is then 0...
  2759.     if {$mapheight < 1} {
  2760.         return
  2761.     }
  2762.  
  2763.     set g(mapheight) $mapheight
  2764.     set g(mapwidth) $mapwidth
  2765.     create-map map $mapwidth $mapheight
  2766. }
  2767.  
  2768. ###############################################################################
  2769. # scroll to diff region nearest to y
  2770. ###############################################################################
  2771.  
  2772. proc map-scroll {y} {
  2773.     global g
  2774.     global w
  2775.     global opts
  2776.  
  2777.     set yview [expr {double ($y) / double($g(mapheight))}]
  2778.     # Show text corresponding to map
  2779.     catch {$w(RightText) yview moveto $yview} result
  2780.     update idletasks
  2781.  
  2782.     # Select the diff region closest to the middle of the screen
  2783.     set winhalf [expr {[winfo height $w(RightText)] / 2}]
  2784.     set result [find-diff [expr {int([$w(RightText) index @1,$winhalf])}]]
  2785.     move [lindex $result 0] 0 0
  2786.  
  2787.     if {$opts(autocenter)} {
  2788.         center
  2789.     }
  2790.  
  2791.     if {$g(showmerge)} {
  2792.         merge-center
  2793.     }
  2794. }
  2795.  
  2796. ###############################################################################
  2797. # Toggle showing map or not
  2798. ###############################################################################
  2799.  
  2800. proc do-show-map {{showMap {}}} {
  2801.     global opts
  2802.     global w
  2803.  
  2804.     if {$showMap != {}} {set opts(showmap) $showMap}
  2805.  
  2806.     if {$opts(showmap)} {
  2807.         grid $w(map) -row 1 -column 1 -stick ns
  2808.     } else {
  2809.         grid forget $w(map)
  2810.     }
  2811. }
  2812.  
  2813. ###############################################################################
  2814. # Find the diff nearest to $line.
  2815. # Returns "$i $newtop" where $i is the index of the diff region
  2816. # and $newtop is the new top line in the window to the right.
  2817. ###############################################################################
  2818.  
  2819. proc find-diff {line} {
  2820.     global g
  2821.     global w
  2822.  
  2823.     set top $line
  2824.     set newtop [expr {$top - int([$w(LeftText) index end]) + \
  2825.             int([$w(RightText) index end])}]
  2826.  
  2827.     for {set low 1; set high $g(count); set i [expr {($low + $high) / 2}]} \
  2828.             {$i >= $low}                                                 \
  2829.             {set i [expr {($low + $high) / 2}]} {
  2830.  
  2831.         foreach {line s1 e1 s2 e2 type} $g(scrdiff,$i) {}
  2832.  
  2833.         if {$s1 > $top} {
  2834.             set newtop [expr {$top - $s1 + $s2}]
  2835.             set high [expr {$i-1}]
  2836.         } else {
  2837.             set low [expr {$i+1}]
  2838.         }
  2839.     }
  2840.  
  2841.     # do some range checking...
  2842.     set i [max 1 [min $i $g(count)]]
  2843.  
  2844.     # If next diff is closer than the one found, use it instead
  2845.     if {$i > 0 && $i < $g(count)} {
  2846.         set nexts1 [lindex $g(scrdiff,[expr {$i + 1}]) 1]
  2847.         set e1 [lindex $g(scrdiff,$i) 2]
  2848.         if {$nexts1 - $top < $top - $e1} {
  2849.             incr i
  2850.         }
  2851.     }
  2852.  
  2853.     return [list $i $newtop]
  2854. }
  2855.  
  2856. ###############################################################################
  2857. # Calculate number of lines in diff region
  2858. # pos       Diff number
  2859. # version   1 or 2, left or right window version
  2860. # screen    1 for screen size, 0 for original diff size
  2861. ###############################################################################
  2862.  
  2863. proc diff-size {pos version {screen 0}} {
  2864.     global g
  2865.  
  2866.     if {$screen} {
  2867.         set diff scrdiff
  2868.     } else {
  2869.         set diff pdiff
  2870.     }
  2871. #    scan $g($diff,$pos) "%s %d %d %d %d %s" \
  2872. #        thisdiff s(1) e(1) s(2) e(2) type
  2873.     foreach {thisdiff s(1) e(1) s(2) e(2) type} $g($diff,$pos)) {}
  2874.  
  2875.     set lines [expr {$e($version) - $s($version) + 1}]
  2876.     if {$type == "d" && $version == 2} {incr lines -1}
  2877.     if {$type == "a" && $version == 1} {incr lines -1}
  2878.     return $lines
  2879. }
  2880.  
  2881. ###############################################################################
  2882. # Toggle showing merge preview or not
  2883. ###############################################################################
  2884.  
  2885. proc do-show-merge {{showMerge ""}} {
  2886.     global g
  2887.     global w
  2888.  
  2889.     if {$showMerge != ""} {
  2890.         set g(showmerge) $showMerge
  2891.     }
  2892.  
  2893.     if {$g(showmerge)} {
  2894.         set-cursor
  2895.         wm deiconify $w(merge)
  2896.         $w(mergeText) configure -state disabled
  2897.         focus -force $w(mergeText)
  2898.         merge-center
  2899.         restore-cursor
  2900.     } else {
  2901.         wm withdraw $w(merge)
  2902.         restore-cursor
  2903.     }
  2904. }
  2905.  
  2906. ###############################################################################
  2907. # Create Merge preview window
  2908. ###############################################################################
  2909.  
  2910. proc merge-create-window {} {
  2911.     global opts
  2912.     global w
  2913.     global g
  2914.  
  2915.     set top .merge
  2916.     set w(merge) $top
  2917.  
  2918.     catch {destroy $top}
  2919.  
  2920.     toplevel $top
  2921.     set x [expr {[winfo rootx .] + 0}]
  2922.     set y [expr {[winfo rooty .] + 0}]
  2923.     wm geometry $top "+${x}+${y}"
  2924.  
  2925.     wm group $top .
  2926.     wm transient $top .
  2927.  
  2928.     wm title $top "$g(name) Merge Preview"
  2929.  
  2930.     frame $top.frame -bd 1 -relief sunken
  2931.     pack $top.frame -side top -fill both -expand y -padx 10 -pady 10
  2932.  
  2933.     set w(mergeText)     $top.frame.text
  2934.     set w(mergeVSB)      $top.frame.vsb
  2935.     set w(mergeHSB)      $top.frame.hsb
  2936.     set w(mergeDismiss)  $top.dismiss
  2937.     set w(mergeWrite)    $top.mergeWrite
  2938.     set w(mergeRecenter) $top.mergeRecenter
  2939.  
  2940.     # Window and scrollbars
  2941.     scrollbar $w(mergeHSB) \
  2942.             -orient horizontal \
  2943.             -command [list $w(mergeText) xview]
  2944.     scrollbar $w(mergeVSB) \
  2945.             -orient vertical \
  2946.             -command [list $w(mergeText) yview]
  2947.  
  2948.     text $w(mergeText) \
  2949.             -bd 0 \
  2950.             -takefocus 1 \
  2951.             -yscrollcommand [list $w(mergeVSB) set] \
  2952.             -xscrollcommand [list $w(mergeHSB) set]
  2953.  
  2954.     grid $w(mergeText) -row 0 -column 0 -sticky nsew
  2955.     grid $w(mergeVSB)  -row 0 -column 1 -sticky ns
  2956.     grid $w(mergeHSB)  -row 1 -column 0 -sticky ew
  2957.  
  2958.     grid rowconfigure $top.frame 0 -weight 1
  2959.     grid rowconfigure $top.frame 1 -weight 0
  2960.  
  2961.     grid columnconfigure $top.frame 0 -weight 1
  2962.     grid columnconfigure $top.frame 1 -weight 0
  2963.  
  2964.     # buttons
  2965.     button $w(mergeRecenter) \
  2966.             -width 8 \
  2967.             -text "ReCenter" \
  2968.             -underline 0 \
  2969.             -command merge-center
  2970.  
  2971.     button $w(mergeDismiss) \
  2972.             -width 8 \
  2973.             -text "Dismiss" \
  2974.             -underline 0 \
  2975.             -command [list do-show-merge 0]
  2976.  
  2977.     button $w(mergeWrite) \
  2978.             -width 8 \
  2979.             -text "Save..." \
  2980.             -underline 0 \
  2981.             -command [list popup-merge merge-write-file]
  2982.  
  2983.     pack $w(mergeDismiss) -side right -pady 5 -padx 10
  2984.     pack $w(mergeRecenter) -side right -pady 5 -padx 1
  2985.     pack $w(mergeWrite) -side right -pady 5 -padx 1
  2986.  
  2987.     eval $w(mergeText) configure $opts(textopt)
  2988.     foreach tag {difftag currtag} {
  2989.         eval $w(mergeText) tag configure $tag $opts($tag)
  2990.     }
  2991.  
  2992.     wm protocol $w(merge) WM_DELETE_WINDOW {do-show-merge 0}
  2993.  
  2994.     # adjust the tag priorities a bit...
  2995.     $w(mergeText) tag raise sel
  2996.     $w(mergeText) tag raise currtag difftag
  2997.  
  2998.     common-navigation $w(mergeText)
  2999.  
  3000.  
  3001.     wm withdraw $w(merge)
  3002. }
  3003.  
  3004. ###############################################################################
  3005. # Read original file (Left window file) into merge preview window.
  3006. # Not so good if it has changed.
  3007. ###############################################################################
  3008.  
  3009. proc merge-read-file {} {
  3010.     global finfo
  3011.     global w
  3012.  
  3013.     set hndl [open "$finfo(pth,1)" r]
  3014.     $w(mergeText) delete 1.0 end
  3015.     $w(mergeText) insert 1.0 [read $hndl]
  3016.     close $hndl
  3017.  
  3018.     # If last line doesn't end with a newline, add one. Important when
  3019.     # writing out the merge preview.
  3020.     if {![regexp {\.0$} [$w(mergeText) index "end-1lines lineend"]]} {
  3021.         $w(mergeText) insert end "\n"
  3022.     }
  3023. }
  3024.  
  3025. ###############################################################################
  3026. # Write merge preview to file
  3027. ###############################################################################
  3028.  
  3029. proc merge-write-file {} {
  3030.     global g
  3031.     global w
  3032.  
  3033.     set hndl [open "$g(mergefile)" w]
  3034.     set text [$w(mergeText) get 1.0 end-1lines]
  3035.     puts -nonewline $hndl $text
  3036.     close $hndl
  3037. }
  3038.  
  3039. ###############################################################################
  3040. # Add a mark where each diff begins and tag diff regions so they are visible.
  3041. # Assumes text is initially the bare original (Left) version.
  3042. ###############################################################################
  3043.  
  3044. proc merge-add-marks {} {
  3045.     global g
  3046.     global w
  3047.  
  3048.     for {set i 1} {$i <= $g(count)} {incr i} {
  3049.         foreach [list thisdiff s1 e1 s2 e2 type] $g(pdiff,$i) {}
  3050.         set delta [expr {$type == "a" ? 1 : 0}]
  3051.         $w(mergeText) mark set mark$i $s1.0+${delta}lines
  3052.         $w(mergeText) mark gravity mark$i left
  3053.  
  3054.         if {$g(merge$i) == 1} {
  3055.             # (If it's an insert it's not visible)
  3056.             if {$type != "a"} {
  3057.                 set lines [expr {$e1 - $s1 + 1}]
  3058.                 $w(mergeText) tag add difftag mark$i mark$i+${lines}lines
  3059.             }
  3060.         } else {
  3061.             # Insert right window version
  3062.             merge-select-version $i 1 2
  3063.         }
  3064.     }
  3065.  
  3066.     # Tag current
  3067.     if {$g(count) > 0} {
  3068.         set pos $g(pos)
  3069.         set lines [diff-size $pos $g(merge$pos)]
  3070.         $w(mergeText) tag add currtag mark$pos "mark$pos+${lines}lines"
  3071.     }
  3072. }
  3073.  
  3074. ###############################################################################
  3075. # Add a mark where each diff begins
  3076. # pos          diff index
  3077. # oldversion   1 or 2, previous merge choice
  3078. # newversion   1 or 2, new merge choice
  3079. ###############################################################################
  3080.  
  3081. proc merge-select-version {pos oldversion newversion} {
  3082.     global g
  3083.     global w
  3084.  
  3085.     set newTextWin $w(LeftText)
  3086.     if {$newversion == 2} {set newTextWin $w(RightText)}
  3087.  
  3088.     catch {
  3089.         set oldlines [diff-size $pos $oldversion]
  3090.         $w(mergeText) delete mark$pos "mark${pos}+${oldlines}lines"
  3091.     }
  3092.  
  3093.     # Screen coordinates
  3094. #    scan $g(scrdiff,$pos) "%s %d %d %d %d %s" \
  3095. #        thisdiff s(1) e(1) s(2) e(2) type
  3096.     foreach {thisdiff s(1) e(1) s(2) e(2) type} $g(scrdiff,$pos) {}
  3097.  
  3098.     # Get the text directly from window
  3099.     set newlines [diff-size $pos $newversion]
  3100.  
  3101.     set newtext [$newTextWin get $s($newversion).0 \
  3102.                      $s($newversion).0+${newlines}lines]
  3103.     # Insert it
  3104.     $w(mergeText) insert mark$pos $newtext diff
  3105.     if {$pos == $g(pos)} {
  3106.         $w(mergeText) tag add currtag mark$pos "mark${pos}+${newlines}lines"
  3107.     }
  3108. }
  3109.  
  3110. ###############################################################################
  3111. # Center the merge region in the merge window
  3112. ###############################################################################
  3113.  
  3114. proc merge-center {} {
  3115.     global g
  3116.     global w
  3117.  
  3118.     # Size of diff in lines of text
  3119.     set difflines [diff-size $g(pos) $g(merge$g(pos))]
  3120.     set yview [$w(mergeText) yview]
  3121.     # Window height in percent
  3122.     set ywindow [expr {[lindex $yview 1] - [lindex $yview 0]}]
  3123.     # First line of diff
  3124.     set firstline [$w(mergeText) index mark$g(pos)]
  3125.     # Total number of lines in window
  3126.     set totallines [$w(mergeText) index end]
  3127.  
  3128.     if {$difflines / $totallines < $ywindow} {
  3129.         # Diff fits in window, center it
  3130.         $w(mergeText) yview moveto [expr {($firstline + $difflines / 2) \
  3131.                 / $totallines - $ywindow / 2}]
  3132.     } else {
  3133.         # Diff too big, show top part
  3134.         $w(mergeText) yview moveto [expr {($firstline - 1) / $totallines}]
  3135.     }
  3136. }
  3137.  
  3138. ###############################################################################
  3139. # Update the merge preview window with the current merge choice
  3140. # newversion   1 or 2, new merge choice
  3141. ###############################################################################
  3142.  
  3143. proc do-merge-choice {newversion} {
  3144.     global g opts
  3145.     global w
  3146.  
  3147.     $w(mergeText) configure -state normal
  3148.     merge-select-version $g(pos) $g(merge$g(pos)) $newversion
  3149.     $w(mergeText) configure -state disabled
  3150.  
  3151.     set g(merge$g(pos)) $newversion
  3152.     if {$g(showmerge) && $opts(autocenter)} {
  3153.         merge-center
  3154.     }
  3155. }
  3156.  
  3157. ###############################################################################
  3158. # Extract the start and end lines for file1 and file2 from the diff
  3159. # stored in "line".
  3160. ###############################################################################
  3161.  
  3162. proc extract {line} {
  3163.     # the line darn well better be of the form <range><op><range>,
  3164.     # where op is one of "a","c" or "d". range will either be a
  3165.     # single number or two numbers separated by a comma.
  3166.  
  3167.     # is this a cool regular expression, or what? :-)
  3168.     regexp {([0-9]*)(,([0-9]*))?([a-z])([0-9]*)(,([0-9]*))?} $line \
  3169.             matchvar s1 x e1 op s2 x e2
  3170.     if {[string length $e1] == 0} {set e1 $s1}
  3171.     if {[string length $e2] == 0} {set e2 $s2}
  3172.  
  3173.     if {[info exists s1] && [info exists s2]} {
  3174. #        return "$line $s1 $e1 $s2 $e2 $op"
  3175.         return [list $line $s1 $e1 $s2 $e2 $op]
  3176.     } else {
  3177.         fatal-error "Cannot parse output from diff:\n$line"
  3178.     }
  3179.  
  3180. }
  3181.  
  3182. ###############################################################################
  3183. # Insert blank lines to match added/deleted lines in other file
  3184. ###############################################################################
  3185.  
  3186. proc add-lines {pos} {
  3187.     global g
  3188.     global w
  3189.  
  3190.     # Figure out which lines we need to address...
  3191.     foreach [list thisdiff s1 e1 s2 e2 type] $g(pdiff,$pos) {}
  3192.  
  3193.     set size(1) [expr {$e1 - $s1}]
  3194.     set size(2) [expr {$e2 - $s2}]
  3195.  
  3196.     incr s1 $g(delta,1)
  3197.     incr s2 $g(delta,2)
  3198.  
  3199.     # Figure out what kind of diff we're dealing with
  3200.     switch $type {
  3201.         "a" {
  3202.             set lefttext  "-" ;# insert
  3203.             set righttext "+"
  3204.             set idx 1
  3205.             set count [expr {$size(2) + 1}]
  3206.  
  3207.             incr s1
  3208.             incr size(2)
  3209.         }
  3210.  
  3211.         "d" {
  3212.             set lefttext  "+" ;# delete
  3213.             set righttext "-"
  3214.             set idx 2
  3215.             set count [expr {$size(1) + 1}]
  3216.  
  3217.             incr s2
  3218.             incr size(1)
  3219.         }
  3220.  
  3221.         "c" {
  3222.             set lefttext  "!" ;# change
  3223.             set righttext "!" ;# change
  3224.             set idx [expr {$size(1) < $size(2) ? 1 : 2}]
  3225.             set count [expr {abs($size(1) - $size(2))}]
  3226.  
  3227.             incr size(1)
  3228.             incr size(2)
  3229.         }
  3230.  
  3231.     }
  3232.  
  3233.     # Put plus signs in left info column
  3234.     if {$idx == 1} {
  3235.         set textWidget $w(LeftText)
  3236.         set infoWidget $w(LeftInfo)
  3237.         set cbWidget   $w(LeftCB)
  3238. #       set blank "++++++\n"
  3239.         set blank "      \n"
  3240.     } else {
  3241.         set textWidget $w(RightText)
  3242.         set infoWidget $w(RightInfo)
  3243.         set cbWidget   $w(RightCB)
  3244.         set blank "      \n"
  3245.     }
  3246.  
  3247.     # Insert blank lines to match other window
  3248.     set line [expr {$s1 + $size($idx)}]
  3249.     for {set i 0} {$i < $count} {incr i} {
  3250.         $textWidget insert $line.0 "\n"
  3251.         $infoWidget insert $line.0 $blank
  3252.         $cbWidget   insert $line.0 "\n"
  3253.     }
  3254.  
  3255.     incr size($idx) $count
  3256.     set e1 [expr {$s1 + $size(1) - 1}]
  3257.     set e2 [expr {$s2 + $size(2) - 1}]
  3258.     incr g(delta,$idx) $count
  3259.  
  3260.     # Insert change bars or text to show what has changed.
  3261.     $w(RightCB) configure -state normal
  3262.     $w(LeftCB) configure -state normal
  3263.     for {set i $s1} {$i <= $e1} {incr i} {
  3264.         $w(LeftCB)  insert $i.0 $lefttext
  3265.         $w(RightCB) insert $i.0 $righttext
  3266.     }
  3267.  
  3268.     # Save the diff block in window coordinates
  3269.     set g(scrdiff,$g(count)) [list $thisdiff $s1 $e1 $s2 $e2 $type]
  3270. }
  3271.  
  3272. ###############################################################################
  3273. # Add a tag to a region.
  3274. ###############################################################################
  3275.  
  3276. proc add-tag {wgt tag start end type new {exact 0}} {
  3277.     global g
  3278.  
  3279.     $wgt tag add $tag $start.0 [expr {$end + 1}].0
  3280.  
  3281. }
  3282.  
  3283. ###############################################################################
  3284. # Change the tag for a diff region.
  3285. # 'pos' is the index in the diff array
  3286. # If 'oldtag' is present, first remove it from the region
  3287. # If 'setpos' is non-zero, make sure the region is visible.
  3288. # Returns the diff expression.
  3289. ###############################################################################
  3290.  
  3291. proc set-tag {pos newtag {oldtag ""} {setpos 0}} {
  3292.     global g opts
  3293.     global w
  3294.  
  3295.     # Figure out which lines we need to address...
  3296.     if {![info exists g(scrdiff,$pos)]} {return}
  3297.     foreach {thisdiff s1 e1 s2 e2 dt} $g(scrdiff,$pos) {}
  3298.  
  3299.     # Remove old tag
  3300.     if {"$oldtag" != ""} {
  3301.         set e1next "[expr {$e1 + 1}].0"
  3302.         set e2next "[expr {$e2 + 1}].0"
  3303.         $w(LeftText)  tag remove $oldtag $s1.0 $e1next
  3304.         $w(LeftInfo)  tag remove $oldtag $s1.0 $e1next
  3305.         $w(RightText) tag remove $oldtag $s2.0 $e2next
  3306.         $w(RightInfo) tag remove $oldtag $s2.0 $e2next
  3307.         $w(LeftCB)    tag remove $oldtag $s1.0 $e1next
  3308.         $w(RightCB)   tag remove $oldtag $s2.0 $e2next
  3309.         catch {
  3310.             set lines [diff-size $pos $g(merge$pos)]
  3311.             $w(mergeText) tag remove $oldtag mark$pos "mark${pos}+${lines}lines"
  3312.         }
  3313.     }
  3314.  
  3315.     switch $dt {
  3316.         "d" { set coltag deltag; set rcbtag "-"; set lcbtag "+" }
  3317.         "a" { set coltag instag; set rcbtag "+"; set lcbtag "-" }
  3318.         "c" { set coltag chgtag; set rcbtag "!"; set lcbtag "!" }
  3319.     }
  3320.  
  3321.     # Add new tag
  3322.     if {$opts(tagtext)} {
  3323.         add-tag $w(LeftText)  $newtag $s1 $e1 $dt 1
  3324.         add-tag $w(RightText) $newtag $s2 $e2 $dt 1
  3325.         add-tag $w(RightText) $coltag $s2 $e2 $dt 1
  3326.     }
  3327.     if {$opts(tagcbs)} {
  3328.         if {$opts(colorcbs)} {
  3329.             add-tag $w(LeftCB)  $lcbtag $s1 $e1 $dt 1
  3330.             add-tag $w(RightCB) $rcbtag $s2 $e2 $dt 1
  3331.         } else {
  3332.             add-tag $w(LeftCB)  $newtag $s1 $e1 $dt 1
  3333.             add-tag $w(RightCB) $newtag $s2 $e2 $dt 1
  3334.             add-tag $w(RightCB) $coltag $s2 $e2 $dt 1
  3335.         }
  3336.  
  3337.     }
  3338.     if {$opts(tagln)} {
  3339.         add-tag $w(LeftInfo)  $newtag $s1 $e1 $dt 1
  3340.         add-tag $w(RightInfo) $newtag $s2 $e2 $dt 1
  3341.         add-tag $w(RightInfo) $coltag $s2 $e2 $dt 1
  3342.     }
  3343.  
  3344.     catch {
  3345.         set lines [diff-size $pos $g(merge$pos)]
  3346.         $w(mergeText) tag add $newtag mark$pos "mark${pos}+${lines}lines"
  3347.     }
  3348.  
  3349.     # Move the view on both text widgets so that the new region is
  3350.     # visible.
  3351.     if {$setpos} {
  3352.         if {$opts(autocenter)} {
  3353.             center
  3354.         } else {
  3355.             $w(LeftText) see $s1.0
  3356.             $w(RightText) see $s2.0
  3357.             $w(LeftText) mark set insert $s1.0
  3358.             $w(RightText) mark set insert $s2.0
  3359.  
  3360.             if {$g(showmerge)} {
  3361.                 $w(mergeText) see mark$pos
  3362.             }
  3363.         }
  3364.     }
  3365.  
  3366.     # make sure the sel tag has the highest priority
  3367.     foreach window [list LeftText RightText LeftCB RightCB LeftInfo RightInfo] {
  3368.         $w($window) tag raise sel
  3369.     }
  3370.  
  3371.     return $thisdiff
  3372. }
  3373.  
  3374. ###############################################################################
  3375. # moves to the diff nearest the insertion cursor or the mouse click,
  3376. # depending on $mode (which should be either "xy" or "mark")
  3377. ###############################################################################
  3378.  
  3379. proc moveNearest {window mode args} {
  3380.     switch $mode {
  3381.         "xy" {
  3382.             set x [lindex $args 0]
  3383.             set y [lindex $args 1]
  3384.             set index [$window index @$x,$y]
  3385.  
  3386.             set line [expr {int($index)}]
  3387.             set diff [find-diff $line]
  3388.         }
  3389.         "mark" {
  3390.             set index [$window index [lindex $args 0]]
  3391.             set line [expr {int($index)}]
  3392.             set diff [find-diff $line]
  3393.         }
  3394.     }
  3395.  
  3396.     # ok, we have an index
  3397.     move [lindex $diff 0] 0 1
  3398. }
  3399.  
  3400. ###############################################################################
  3401. ###############################################################################
  3402.  
  3403. proc moveTo {window value} {
  3404.     global w
  3405.     global g
  3406.     # we know that the value is prefixed by the nunber/index of
  3407.     # the diff the user wants. So, just grab that out of the string
  3408.     regexp {([0-9]+) *:} $value matchVar index
  3409.     move $index 0
  3410. }
  3411.  
  3412. ###############################################################################
  3413. # this is called when the user scrolls the map thumb interactively.
  3414. ###############################################################################
  3415. proc map-seek {y} {
  3416.     global g
  3417.     global w
  3418.  
  3419.     incr y -2
  3420.     set yview [expr {(double($y) / double($g(mapheight)))}]
  3421.  
  3422.     # Show text corresponding to map;
  3423.     $w(RightText) yview moveto $yview
  3424. }
  3425.  
  3426.  
  3427. ###############################################################################
  3428. # Move the "current" diff indicator (i.e. go to the next or previous diff
  3429. # region if "relative" is 1; go to an absolute diff number if "relative"
  3430. # is 0).
  3431. ###############################################################################
  3432.  
  3433. proc move {value {relative 1} {setpos 1}} {
  3434.     global g
  3435.     global w
  3436.  
  3437.     if {$value == "first"} {set value 1; set relative 0}
  3438.     if {$value == "last"}  {set value $g(count); set relative 0}
  3439.  
  3440.     # Remove old 'curr' tag
  3441.     set-tag $g(pos) difftag currtag
  3442.  
  3443.     # Bump 'pos' (one way or the other).
  3444.     if {$relative} {
  3445.         set g(pos) [expr {$g(pos) + $value}]
  3446.     } else {
  3447.         set g(pos) $value
  3448.     }
  3449.  
  3450.     # Range check 'pos'.
  3451.     set g(pos) [min $g(pos) $g(count)]
  3452.     set g(pos) [max $g(pos) 1]
  3453.  
  3454.     # Set new 'curr' tag
  3455.     set g(currdiff) [set-tag $g(pos) currtag "" $setpos]
  3456.  
  3457.     # update the buttons..
  3458.     update-display
  3459.  
  3460. }
  3461.  
  3462. proc update-display {} {
  3463.     global g
  3464.     global w
  3465.  
  3466.     if {!$g(initOK)} {
  3467.         # disable darn near everything
  3468.         foreach widget [list combo prevDiff firstDiff nextDiff lastDiff \
  3469.                 centerDiffs mergeChoice1 mergeChoice2 find mergeChoiceLabel \
  3470.                 combo ] {
  3471.             $w($widget) configure -state disabled
  3472.         }
  3473.         foreach menu [list $w(popupMenu) $w(viewMenu)] {
  3474.             $menu entryconfigure "Previous*" -state disabled
  3475.             $menu entryconfigure "First*"    -state disabled
  3476.             $menu entryconfigure "Next*"     -state disabled
  3477.             $menu entryconfigure "Last*"     -state disabled
  3478.             $menu entryconfigure "Center*"   -state disabled
  3479.         }
  3480.         $w(popupMenu) entryconfigure "Find..."       -state disabled
  3481.         $w(popupMenu) entryconfigure "Find Nearest*" -state disabled
  3482.         $w(popupMenu) entryconfigure "Edit*"         -state disabled
  3483.  
  3484.         $w(editMenu)  entryconfigure "Find*"     -state disabled
  3485.         $w(editMenu)  entryconfigure "Edit File 1" -state disabled
  3486.         $w(editMenu)  entryconfigure "Edit File 2" -state disabled
  3487.  
  3488.         $w(fileMenu)  entryconfigure "Write*"        -state disabled
  3489.         $w(fileMenu)  entryconfigure "Recompute*"    -state disabled
  3490.  
  3491.         $w(mergeMenu) entryconfigure "Show*" -state disabled
  3492.         $w(mergeMenu) entryconfigure "Write*" -state disabled
  3493.  
  3494.     } else {
  3495.         # these are always enabled, assuming we have properly
  3496.         # diffed a couple of files
  3497.         $w(popupMenu) entryconfigure "Find..."      -state normal
  3498.         $w(popupMenu) entryconfigure "Find Nearest*" -state normal
  3499.         $w(popupMenu) entryconfigure "Edit*"         -state normal
  3500.  
  3501.         $w(mergeChoice1)     configure -state normal
  3502.         $w(mergeChoice2)     configure -state normal
  3503.         $w(mergeChoiceLabel) configure -state normal
  3504.  
  3505.         $w(editMenu)  entryconfigure "Find*"       -state normal
  3506.         $w(editMenu)  entryconfigure "Edit File 1" -state normal
  3507.         $w(editMenu)  entryconfigure "Edit File 2" -state normal
  3508.  
  3509.         $w(fileMenu)  entryconfigure "Write*"      -state normal
  3510.         $w(fileMenu)  entryconfigure "Recompute*"    -state normal
  3511.  
  3512.         $w(mergeMenu) entryconfigure "Show*" -state normal
  3513.         $w(mergeMenu) entryconfigure "Write*" -state normal
  3514.  
  3515.         $w(find) configure -state normal
  3516.         $w(combo) configure -state normal
  3517.     }
  3518.  
  3519.     # Update the toggles.
  3520.     if {$g(count)} {
  3521.         set g(toggle) $g(merge$g(pos))
  3522.     }
  3523.  
  3524.     # update the status line
  3525.     set g(statusCurrent) "$g(pos) of $g(count)"
  3526.  
  3527.     # update the combobox. We don't want it's command to fire, so
  3528.     # we'll disable it temporarily
  3529.     $w(combo) configure -commandstate "disabled"
  3530.     set i [expr {$g(pos) - 1}]
  3531.     $w(combo) configure -value [lindex [$w(combo) list get 0 end] $i]
  3532.     $w(combo) selection clear
  3533.     $w(combo) configure -commandstate "normal"
  3534.  
  3535.     # update the widgets
  3536.     if {$g(pos) <= 1} {
  3537.         $w(prevDiff) configure -state disabled
  3538.         $w(firstDiff) configure -state disabled
  3539.         $w(popupMenu) entryconfigure "Previous*" -state disabled
  3540.         $w(popupMenu) entryconfigure "First*"    -state disabled
  3541.         $w(viewMenu) entryconfigure "Previous*" -state disabled
  3542.         $w(viewMenu) entryconfigure "First*"    -state disabled
  3543.     } else {
  3544.         $w(prevDiff) configure -state normal
  3545.         $w(firstDiff) configure -state normal
  3546.         $w(popupMenu) entryconfigure "Previous*" -state normal
  3547.         $w(popupMenu) entryconfigure "First*"    -state normal
  3548.         $w(viewMenu) entryconfigure "Previous*" -state normal
  3549.         $w(viewMenu) entryconfigure "First*"    -state normal
  3550.     }
  3551.  
  3552.     if {$g(pos) >= $g(count)} {
  3553.         $w(nextDiff) configure -state disabled
  3554.         $w(lastDiff) configure -state disabled
  3555.         $w(popupMenu) entryconfigure "Next*"  -state disabled
  3556.         $w(popupMenu) entryconfigure "Last*" -state disabled
  3557.         $w(viewMenu) entryconfigure "Next*"  -state disabled
  3558.         $w(viewMenu) entryconfigure "Last*" -state disabled
  3559.     } else {
  3560.         $w(nextDiff) configure -state normal
  3561.         $w(lastDiff) configure -state normal
  3562.         $w(popupMenu) entryconfigure "Next*"  -state normal
  3563.         $w(popupMenu) entryconfigure "Last*" -state normal
  3564.         $w(viewMenu) entryconfigure "Next*"  -state normal
  3565.         $w(viewMenu) entryconfigure "Last*" -state normal
  3566.     }
  3567.  
  3568.     if {$g(count) > 0} {
  3569.         $w(centerDiffs) configure -state normal
  3570.         $w(popupMenu) entryconfigure "Center*" -state normal
  3571.         $w(viewMenu) entryconfigure "Center*" -state normal
  3572.  
  3573.     } else {
  3574.         $w(centerDiffs) configure -state disabled
  3575.         $w(popupMenu) entryconfigure "Center*" -state disabled
  3576.         $w(viewMenu) entryconfigure "Center*" -state disabled
  3577.     }
  3578. }
  3579.  
  3580. ###############################################################################
  3581. # Center the top line of the CDR in each window.
  3582. ###############################################################################
  3583.  
  3584. proc center {} {
  3585.     global g
  3586.     global w
  3587.  
  3588. #    scan $g(scrdiff,$g(pos)) "%s %d %d %d %d %s" dummy s1 e1 s2 e2 dt
  3589.     foreach {dummy s1 e1 s2 e2 dt} $g(scrdiff,$g(pos)) {}
  3590.  
  3591.     # Window requested height in pixels
  3592.     set opix [winfo reqheight $w(LeftText)]
  3593.     # Window requested lines
  3594.     set olin [$w(LeftText) cget -height]
  3595.     # Current window height in pixels
  3596.     set npix [winfo height $w(LeftText)]
  3597.  
  3598.     # Visible lines
  3599.     set winlines [expr {$npix * $olin / $opix}]
  3600.     # Lines in diff
  3601.     set diffsize [max [expr {$e1 - $s1 + 1}] [expr {$e2 - $s2 + 1}]]
  3602.  
  3603.     if {$diffsize < $winlines} {
  3604.         set h [expr {($winlines - $diffsize) / 2}]
  3605.     } else {
  3606.         set h 2
  3607.     }
  3608.  
  3609.     set o [expr {$s1 - $h}]
  3610.     if {$o < 0} { set o 0 }
  3611.     set n [expr {$s2 - $h}]
  3612.     if {$n < 0} { set n 0 }
  3613.  
  3614.     $w(LeftText)  mark set insert $s1.0
  3615.     $w(RightText) mark set insert $s2.0
  3616.     $w(LeftText) yview $o
  3617.     $w(RightText) yview $n
  3618.  
  3619.     if {$g(showmerge)} {
  3620.         merge-center
  3621.     }
  3622. }
  3623.  
  3624. ###############################################################################
  3625. # Change the state on all of the diff-sensitive buttons.
  3626. ###############################################################################
  3627.  
  3628. proc buttons {{newstate "normal"}} {
  3629.     global w
  3630.     $w(combo)       configure -state $newstate
  3631.     $w(prevDiff)    configure -state $newstate
  3632.     $w(nextDiff)    configure -state $newstate
  3633.     $w(firstDiff)   configure -state $newstate
  3634.     $w(lastDiff)    configure -state $newstate
  3635.     $w(centerDiffs) configure -state $newstate
  3636. }
  3637.  
  3638. ###############################################################################
  3639. # Wipe the slate clean...
  3640. ###############################################################################
  3641.  
  3642. proc wipe {} {
  3643.     global g
  3644.     global finfo
  3645.  
  3646.     set g(pos)      0
  3647.     set g(count)    0
  3648.     set g(diff)     ""
  3649.     set g(currdiff) ""
  3650.  
  3651.     set g(delta,1)    0
  3652.     set g(delta,2)    0
  3653. }
  3654.  
  3655. ###############################################################################
  3656. # Wipe all data and all windows
  3657. ###############################################################################
  3658.  
  3659. proc wipe-window {} {
  3660.     global g
  3661.     global w
  3662.  
  3663.     wipe
  3664.  
  3665.     foreach mod {Left Right} {
  3666.         $w(${mod}Text) configure -state normal
  3667.         $w(${mod}Text) tag remove difftag 1.0 end
  3668.         $w(${mod}Text) tag remove currtag 1.0 end
  3669.         $w(${mod}Text) delete 1.0 end
  3670.  
  3671.         $w(${mod}Info) configure -state normal
  3672.         $w(${mod}Info) delete 1.0 end
  3673.         $w(${mod}CB)   configure -state normal
  3674.         $w(${mod}CB) delete 1.0 end
  3675.     }
  3676.  
  3677.     catch {$w(mergeText) delete 1.0 end }
  3678.  
  3679.     if {[string length $g(destroy)] > 0} {
  3680.         eval $g(destroy)
  3681.         set g(destroy) ""
  3682.     }
  3683.  
  3684.     $w(combo) list delete 0 end
  3685.     buttons disabled
  3686.  
  3687. }
  3688.  
  3689. ###############################################################################
  3690. # Mark difference regions and build up the combobox
  3691. ###############################################################################
  3692.  
  3693. proc mark-diffs {} {
  3694.     global g
  3695.     global w
  3696.  
  3697.     set numdiff [llength "$g(diff)"]
  3698.  
  3699.     set g(count) 0
  3700.  
  3701.  
  3702.     # ain't this clever? We want to update the display as soon as
  3703.     # we've marked enough diffs to fill the display so the user will
  3704.     # have the impression we're fast. But, we don't want this
  3705.     # want this code to slow us down too much, so we'll put the
  3706.     # code in a variable and delete it when its no longer needed.
  3707.     set hack {
  3708.         # for now, just pick a number out of thin air. Ideally
  3709.         # we'd compute the number of lines that are visible and
  3710.         # use that, but I'm too lazy today...
  3711.         if {$g(count) > 25} {
  3712.             update idletasks
  3713.             set hack {}
  3714.         }
  3715.     }
  3716.  
  3717.     foreach d $g(diff) {
  3718.         set result [extract $d]
  3719.  
  3720.         if {$result != ""} {
  3721.             incr g(count)
  3722.             set g(merge$g(count)) 1
  3723.  
  3724.             set g(pdiff,$g(count)) "$result"
  3725.             add-lines $g(count)
  3726.  
  3727. #            set-tag $g(count) difftag
  3728.  
  3729.             $w(combo) list insert end [format "%-6d: %s" $g(count) $d]
  3730.  
  3731.             eval $hack
  3732.         }
  3733.  
  3734.     }
  3735.  
  3736.     remark-diffs
  3737.     return $g(count)
  3738. }
  3739.  
  3740. ###############################################################################
  3741. # start a new diff
  3742. ###############################################################################
  3743. proc do-new-diff {args} {
  3744.     global argv argc
  3745.     global g
  3746.  
  3747.     if {[llength $args] == 0} {
  3748.         set args [newDiff popup]
  3749.         if {[llength $args] == 0} {
  3750.             return 0
  3751.         }
  3752.         set argv $args
  3753.         set argc [llength $args]
  3754.     }
  3755.  
  3756.     set-cursor
  3757.     set g(disableSyncing) 1 ;# turn off syncing until things settle down
  3758.  
  3759.     # remove all evidence of previous diff
  3760.     wipe-window
  3761.     update idletasks
  3762.  
  3763.     set result [catch init-files output]
  3764.     check-error $result $output
  3765.     if {$result} {
  3766.         # drat! Probably ought to display the newDiff dialog
  3767.         # or something.
  3768.         set ret 0
  3769.  
  3770.     } else {
  3771.  
  3772.         # do the diff
  3773.         do-diff
  3774.  
  3775.         move first
  3776.  
  3777.         set ret 1
  3778.     }
  3779.  
  3780.     restore-cursor
  3781.  
  3782.     update-display
  3783.     unset g(disableSyncing)
  3784.  
  3785.     return $ret
  3786. }
  3787.  
  3788. ###############################################################################
  3789. # Remark difference regions...
  3790. ###############################################################################
  3791.  
  3792. proc remark-diffs {} {
  3793.     global g
  3794.     global w
  3795.     global opts
  3796.  
  3797.     # delete all known tags.
  3798.     foreach window [list $w(LeftText) $w(LeftInfo) $w(LeftCB) \
  3799.             $w(RightText) $w(RightInfo) $w(RightCB)] {
  3800.         eval $window tag delete [$window tag names]
  3801.     }
  3802.  
  3803.     # reconfigure all the tags based on the current options
  3804.     # first, the common tags:
  3805.     foreach tag {difftag currtag deltag instag chgtag} {
  3806.         foreach win [list $w(LeftText)  $w(LeftInfo)  $w(LeftCB) \
  3807.                           $w(RightText) $w(RightInfo) $w(RightCB)] {
  3808.             if {[catch "$win tag configure $tag $opts($tag)"]} {
  3809.                 do-error "Invalid settings\n\n$opts($tag)"
  3810.                 eval "$win tag configure $tag $opts($tag)"
  3811.                 return
  3812.             }
  3813.         }
  3814.     }
  3815.  
  3816.     # next, changebar-specific tags
  3817.     foreach widget [list $w(LeftCB) $w(RightCB)] {
  3818.         eval $widget tag configure + $opts(+)
  3819.         eval $widget tag configure - $opts(-)
  3820.         eval $widget tag configure ! $opts(!)
  3821.     }
  3822.  
  3823.     # now, reapply the tags to all the diff regions
  3824.     for {set i 1} {$i <= $g(count)} {incr i} {
  3825.         set-tag $i difftag
  3826.     }
  3827.  
  3828.     # finally, reset the current diff
  3829.     set-tag $g(pos) currtag "" 0
  3830.  
  3831. }
  3832.  
  3833.  
  3834. ###############################################################################
  3835. # Put up some informational text.
  3836. ###############################################################################
  3837.  
  3838. proc show-info {message} {
  3839.     global g
  3840.  
  3841. #    set g(currdiff) $message
  3842.     set g(statusInfo) $message
  3843.     update idletasks
  3844. }
  3845.  
  3846. ###############################################################################
  3847. # Compute differences (start over, basically).
  3848. ###############################################################################
  3849.  
  3850. proc rediff {} {
  3851.     global g
  3852.     global opts
  3853.     global finfo
  3854.     global tcl_platform
  3855.     global w
  3856.  
  3857.     buttons disabled
  3858.  
  3859.     # Read the files into their respective widgets & add line numbers.
  3860.      foreach mod {1 2} {
  3861.         if {$mod == 1} {set text $w(LeftText)} {set text $w(RightText)}
  3862.         show-info "reading $finfo(pth,$mod)..."
  3863.         if {[catch {set hndl [open "$finfo(pth,$mod)" r]}]} {
  3864.             fatal-error "Failed to open file: $finfo(pth,$mod)"
  3865.         }
  3866.         $text insert 1.0 [read $hndl]
  3867.         close $hndl
  3868.  
  3869.         # Check if last line doesn't end with newline
  3870.         if {![regexp {\.0$} [$text index "end-1lines lineend"]]} {
  3871.             $text insert end "  <-- newline inserted by $g(name)\n"
  3872.         }
  3873.     }
  3874.  
  3875.     # Diff the two files and store the summary lines into 'g(diff)'.
  3876.     set diffcmd "$opts(diffcmd) {$finfo(pth,1)} {$finfo(pth,2)}"
  3877.     show-info "Executing \"$diffcmd\""
  3878.  
  3879.  
  3880.     set result [run-command "exec $diffcmd"]
  3881.     set stdout   [lindex $result 0]
  3882.     set stderr   [lindex $result 1]
  3883.     set exitcode [lindex $result 2]
  3884.     set g(returnValue) $exitcode
  3885.  
  3886.     # The exit code is 0 if there are no differences and 1 if there
  3887.     # are differences. Any other exit code means trouble and we abort.
  3888.     if {$exitcode < 0 || $exitcode > 1 || $stderr != ""} {
  3889.         fatal-error "diff failed:\n$stderr"
  3890.     }
  3891.  
  3892.     set g(diff) {}
  3893.     set lines [split $stdout "\n"]
  3894.  
  3895.     # If there is no output and we got this far the files are equal,
  3896.     # otherwise check if the first line begins with a line number. If
  3897.     # not there was trouble and we abort. For instance, using a binary
  3898.     # file results in the message "Binary files ..." etc on stdout,
  3899.     # exit code 1. The message may wary depending on locale.
  3900.     if {$lines != "" && [string match {[0-9]*} $lines] != 1} {
  3901.         fatal-error "diff failed:\n$stdout"
  3902.     }
  3903.  
  3904.     # Collect all lines containing line numbers
  3905.     foreach line $lines {
  3906.         if {[string match {[0-9]*} $line]} { lappend g(diff) $line }
  3907.     }
  3908.  
  3909.     # Mark up the two text widgets and go to the first diff (if there
  3910.     # is one).
  3911.  
  3912.     draw-line-numbers
  3913.  
  3914.     show-info "Marking differences..."
  3915.  
  3916.     $w(LeftInfo)  configure -state normal
  3917.     $w(RightInfo) configure -state normal
  3918.     $w(LeftCB)    configure -state normal
  3919.     $w(RightCB)   configure -state normal
  3920.  
  3921.     if {[mark-diffs]} {
  3922.         set g(pos) 1
  3923.         move 1 0
  3924.         buttons normal
  3925.     } else {
  3926.         after idle {show-info "Files are identical."}
  3927.         buttons disabled
  3928.     }
  3929.  
  3930.     # Prevent tampering in the line number widgets. The text
  3931.     # widgets are already taken care of
  3932.     $w(LeftInfo)  configure -state disabled
  3933.     $w(RightInfo) configure -state disabled
  3934.     $w(LeftCB)    configure -state disabled
  3935.     $w(RightCB)   configure -state disabled
  3936. }
  3937.  
  3938. ###############################################################################
  3939. # Set the X cursor to "watch" for a window and all of its descendants.
  3940. ###############################################################################
  3941.  
  3942. proc set-cursor {args} {
  3943.     global current
  3944.     global w
  3945.  
  3946.     . configure -cursor watch
  3947.     $w(LeftText) configure -cursor watch
  3948.     $w(RightText) configure -cursor watch
  3949.     $w(combo) configure -cursor watch
  3950.     update idletasks
  3951.  
  3952. }
  3953.  
  3954. ###############################################################################
  3955. # Restore the X cursor for a window and all of its descendants.
  3956. ###############################################################################
  3957.  
  3958. proc restore-cursor {args} {
  3959.     global current
  3960.     global w
  3961.  
  3962.     . configure -cursor {}
  3963.     $w(LeftText) configure -cursor {}
  3964.     $w(RightText) configure -cursor {}
  3965.     $w(combo) configure -cursor {}
  3966.     show-info ""
  3967.     update idletasks
  3968. }
  3969.  
  3970. ###############################################################################
  3971. # Check if error was thrown by us or unexpected
  3972. ###############################################################################
  3973.  
  3974. proc check-error {result output} {
  3975.     global g errorInfo
  3976.  
  3977.     if {$result && $output != "Fatal"} {
  3978.         error $result $errorInfo
  3979.     }
  3980. }
  3981.  
  3982.  
  3983. ###############################################################################
  3984. # redo the current diff. Attempt to return to the same diff region,
  3985. # numerically speaking.
  3986. ###############################################################################
  3987. proc recompute-diff {} {
  3988.     global g
  3989.     set current $g(pos)
  3990.  
  3991.     do-diff
  3992.     move $current 0
  3993.  
  3994.     update-display
  3995. }
  3996.  
  3997.  
  3998. ###############################################################################
  3999. # Flash the "rediff" button and then kick off a rediff.
  4000. ###############################################################################
  4001.  
  4002. proc do-diff {} {
  4003.     global g map errorInfo
  4004.     global opts
  4005.  
  4006.     set-cursor
  4007.     update idletasks
  4008.  
  4009.     wipe-window
  4010.     update idletasks
  4011.     set result [catch {
  4012.         if {$g(mapheight)} {
  4013.             map blank
  4014.         }
  4015.         init-files
  4016.         rediff
  4017.         merge-read-file
  4018.         merge-add-marks
  4019.  
  4020.         # If a map exists, recreate it
  4021.         if {$opts(showmap)} {
  4022.             set g(mapheight) -1
  4023.             map-resize
  4024.         }
  4025.     } output]
  4026.  
  4027.     check-error $result $output
  4028.  
  4029.     restore-cursor
  4030. }
  4031.  
  4032. ###############################################################################
  4033. # Get things going...
  4034. ###############################################################################
  4035.  
  4036. proc main {} {
  4037.     global argv
  4038.     global w
  4039.     global g errorInfo
  4040.     global startupError
  4041.  
  4042.     wm withdraw .
  4043.     wm protocol . WM_DELETE_WINDOW do-exit
  4044.     wm title . "$g(name) $g(version)"
  4045.  
  4046.     wipe
  4047.  
  4048.     create-display
  4049.     update-display
  4050.     update
  4051.  
  4052.     merge-create-window
  4053.  
  4054.     do-show-linenumbers
  4055.     do-show-map
  4056.  
  4057.     eval do-new-diff $argv
  4058.  
  4059.     move first
  4060.  
  4061.     wm deiconify .
  4062.     update idletasks
  4063.  
  4064.     if {[info exists startupError]} {
  4065.         tk_messageBox \
  4066.                 -icon warning \
  4067.                 -type ok \
  4068.                 -title "$g(name) - Error in Startup File" \
  4069.                 -message $startupError
  4070.     }
  4071. }
  4072.  
  4073.  
  4074. ###############################################################################
  4075. # Erase tmp files (if necessary) and destroy the application.
  4076. ###############################################################################
  4077.  
  4078. proc del-tmp {} {
  4079.     global g finfo
  4080.  
  4081.     if {$finfo(tmp,1)} {file delete $finfo(pth,1)}
  4082.     if {$finfo(tmp,2)} {file delete $finfo(pth,2)}
  4083.     foreach f $g(tempfiles) {file delete $f}
  4084. }
  4085.  
  4086. ###############################################################################
  4087. # Throw up a window with formatted text
  4088. ###############################################################################
  4089.  
  4090. proc do-text-info {w title text} {
  4091.     global g
  4092.  
  4093.     catch "destroy $w"
  4094.     toplevel $w
  4095.     wm title $w "$g(name) Help - $title"
  4096.     set x [expr {[winfo rootx .] + 0}]
  4097.     set y [expr {[winfo rooty .] + 0}]
  4098.  
  4099.     wm geometry $w "=55x29+${x}+${y}"
  4100.     wm group $w .
  4101.     wm transient $w .
  4102.  
  4103.     frame $w.f -bd 1 -relief sunken
  4104.     pack $w.f -side top -fill both -expand y
  4105.  
  4106.     text $w.f.title \
  4107.             -highlightthickness 0 \
  4108.             -bd 0 \
  4109.             -height 2 \
  4110.             -wrap word \
  4111.             -width 50 \
  4112.             -background white \
  4113.             -foreground black
  4114.  
  4115.     text $w.f.text \
  4116.             -wrap word \
  4117.             -setgrid true \
  4118.             -padx 20 \
  4119.             -highlightthickness 0 \
  4120.             -bd 0 \
  4121.             -width 50 \
  4122.             -height 20 \
  4123.             -yscroll [list $w.f.vsb set] \
  4124.             -background white\
  4125.             -foreground black
  4126.     scrollbar $w.f.vsb \
  4127.             -command [list $w.f.text yview] \
  4128.             -orient vertical
  4129.  
  4130.     pack $w.f.vsb -side right -fill y -expand n
  4131.     pack $w.f.title -side top -fill x -expand n
  4132.     pack $w.f.text -side left -fill both -expand y
  4133.  
  4134.     focus $w.f.text
  4135.  
  4136.     button $w.done -text Dismiss -command "destroy $w"
  4137.     pack $w.done -side right -fill none -pady 5 -padx 5
  4138.  
  4139.     put-text $w.f.title "<ttl>$title</ttl>"
  4140.     put-text $w.f.text $text
  4141.     $w.f.text configure -state disabled
  4142. }
  4143.  
  4144.  
  4145. ###############################################################################
  4146. # centers window w over parent
  4147. ###############################################################################
  4148. proc centerWindow {w {size {}}} {
  4149.     update
  4150.     set parent .
  4151.  
  4152.     if {[llength $size] > 0} {
  4153.         set wWidth [lindex $size 0]
  4154.         set wHeight [lindex $size 1]
  4155.     } else {
  4156.         set wWidth  [winfo reqwidth $w]
  4157.         set wHeight [winfo reqheight $w]
  4158.     }
  4159.  
  4160.     set pWidth  [winfo reqwidth $parent]
  4161.     set pHeight [winfo reqheight $parent]
  4162.     set pX      [winfo rootx $parent]
  4163.     set pY      [winfo rooty $parent]
  4164.  
  4165.     set centerX [expr {$pX + ($pWidth / 2)}]
  4166.     set centerY [expr {$pY + ($pHeight / 2)}]
  4167.  
  4168.     set x [expr {$centerX - ($wWidth / 2)}]
  4169.     set y [expr {$centerY - ($wHeight / 2)}]
  4170.  
  4171.     wm geometry $w "=${wWidth}x${wHeight}+${x}+${y}"
  4172.     update
  4173.  
  4174. }
  4175.  
  4176. ###############################################################################
  4177. # all the code to handle the "New Diff" dialog
  4178. ###############################################################################
  4179. proc newDiff {command args} {
  4180.     global g w
  4181.     global finfo
  4182.  
  4183.     set w(newDiffPopup) .newDiffPopup
  4184.  
  4185.     switch $command {
  4186.         "popup" {
  4187.             if {![winfo exists $w(newDiffPopup)]} {
  4188.                 newDiff build
  4189.                 centerWindow $w(newDiffPopup)
  4190.             }
  4191.  
  4192.             wm deiconify $w(newDiffPopup)
  4193.             raise $w(newDiffPopup)
  4194.             tkwait variable g(newDiffArgs)
  4195.             wm withdraw $w(newDiffPopup)
  4196.  
  4197.             # handle result...
  4198.             return $g(newDiffArgs)
  4199.         }
  4200.  
  4201.         "ok" {
  4202.             # normally we would retrieve the switch value based
  4203.             # on a radio button or option menu or some such on
  4204.             # the dialog, but for now we only support one type of
  4205.             # diff from the dialog...
  4206.  
  4207.             # handle the various permutations...
  4208.             switch 1 {
  4209.                 1 {
  4210.                     set f1 [file nativename $g(newDiff,simple,original)]
  4211.                     set f2 [file nativename $g(newDiff,simple,revision)]
  4212.                     if {![file exists $f1]} {
  4213.                         tk_messageBox \
  4214.                                 -icon warning \
  4215.                                 -title "File does not exist" \
  4216.                                 -message "The file $f1 does not exist" \
  4217.                                 -type ok
  4218.                         return
  4219.                     }
  4220.                     if {![file exists $f2]} {
  4221.                         tk_messageBox \
  4222.                                 -icon warning \
  4223.                                 -title "File does not exist" \
  4224.                                 -message "The file $f2 does not exist" \
  4225.                                 -type ok
  4226.                         return
  4227.                     }
  4228.                     # setting this variable will cause popup
  4229.                     # to close the window...
  4230.                     set g(newDiffArgs) [list $f1 $f2]
  4231.                 }
  4232.             }
  4233.         }
  4234.  
  4235.         "cancel" {
  4236.             set g(newDiffArgs) {}
  4237.             return
  4238.         }
  4239.  
  4240.         "browse" {
  4241.             # n.b.: args(0) is dialog title; args(1) is entry widget
  4242.             set title [lindex $args 0]
  4243.             set widget [lindex $args 1]
  4244.             set filename [tk_getOpenFile -title $title \
  4245.                     -initialfile [$widget get]]
  4246.             if {[string length $filename] > 0} {
  4247.                 $widget delete 0 end
  4248.                 $widget insert 0 $filename
  4249.                 $widget selection range 0 end
  4250.                 $widget xview end
  4251.                 focus $widget
  4252.                 return 1
  4253.             } else {
  4254.                 after idle {raise $w(newDiffPopup)}
  4255.                 return 0
  4256.             }
  4257.         }
  4258.  
  4259.         "build" {
  4260.  
  4261.             catch {destroy $w(newDiffPopup)}
  4262.             toplevel $w(newDiffPopup)
  4263.  
  4264.             wm group     $w(newDiffPopup) .
  4265.             wm transient $w(newDiffPopup) .
  4266.             wm title     $w(newDiffPopup) "New Diff"
  4267.  
  4268.             wm protocol  $w(newDiffPopup) WM_DELETE_WINDOW {newDiff cancel}
  4269.  
  4270.             wm withdraw  $w(newDiffPopup)
  4271.  
  4272.             set x [expr {[winfo rootx .] + 0}]
  4273.             set y [expr {[winfo rooty .] + 0}]
  4274.  
  4275.             # ultimately it might be nice to support all the
  4276.             # modes even though for now all we'll support is the
  4277.             # two-file mode. But, to make the transition easier
  4278.             # we'll put all of the widgets for this mode in its own
  4279.             # frame which can ultimately be controlled by a notebook
  4280.             # widget
  4281.             set simple [frame $w(newDiffPopup).simple -borderwidth 2 -relief groove]
  4282.             label $simple.l1 -text "Original File:"
  4283.             label $simple.l2 -text "Revised File:"
  4284.  
  4285.             entry $simple.e1 -textvariable g(newDiff,simple,original)
  4286.             entry $simple.e2 -textvariable g(newDiff,simple,revision)
  4287.  
  4288.             set g(newDiff,simple,original) $finfo(pth,1)
  4289.             set g(newDiff,simple,revision) $finfo(pth,2)
  4290.  
  4291.             # we want these buttons to be the same height as
  4292.             # the entry, so we'll try to force the issue...
  4293.             button $simple.b1 \
  4294.                     -borderwidth 1 \
  4295.                     -highlightthickness 0 \
  4296.                     -text "Browse..." \
  4297.                     -command [list newDiff browse "Original File" $simple.e1]
  4298.             button $simple.b2 \
  4299.                     -borderwidth 1 \
  4300.                     -highlightthickness 0 \
  4301.                     -text "Browse..." \
  4302.                     -command [list newDiff browse "Revised File" $simple.e2]
  4303.  
  4304.             # we'll use the grid geometry manager to get things lined up right...
  4305.             grid $simple.l1 -row 0 -column 0 -sticky e
  4306.             grid $simple.e1 -row 0 -column 1 -sticky nsew
  4307.             grid $simple.b1 -row 0 -column 2 -sticky nsew -pad 4
  4308.  
  4309.             grid $simple.l2 -row 1 -column 0 -sticky e
  4310.             grid $simple.e2 -row 1 -column 1 -sticky nsew
  4311.             grid $simple.b2 -row 1 -column 2 -sticky nsew -pad 4
  4312.  
  4313.             grid columnconfigure $simple 0 -weight 0
  4314.             grid columnconfigure $simple 1 -weight 1
  4315.             grid columnconfigure $simple 2 -weight 0
  4316.  
  4317.             # here are the buttons for this dialog...
  4318.             set commands [frame $w(newDiffPopup).buttons]
  4319.             button $commands.ok \
  4320.                     -text "Ok" \
  4321.                     -width 5 \
  4322.                     -command [list newDiff ok] \
  4323.                     -default active
  4324.             button $commands.cancel \
  4325.                     -text "Cancel" \
  4326.                     -width 5 \
  4327.                     -command [list newDiff cancel] \
  4328.                     -default normal
  4329.  
  4330.             pack $commands.ok $commands.cancel \
  4331.                     -side left \
  4332.                     -fill none \
  4333.                     -expand y \
  4334.                     -pady 4
  4335.  
  4336.             catch {$commands.ok -default 1}
  4337.  
  4338.             # pack this crud in...
  4339.             pack $simple \
  4340.                     -side top \
  4341.                     -fill both \
  4342.                     -expand y \
  4343.                     -ipady 20 \
  4344.                     -ipadx 20 \
  4345.                     -padx 5 \
  4346.                     -pady 5
  4347.             pack $commands -side bottom -fill x -expand n
  4348.  
  4349.             bind $w(newDiffPopup) <Return> [list $commands.ok invoke]
  4350.             bind $w(newDiffPopup) <Escape> [list $commands.cancel invoke]
  4351.         }
  4352.  
  4353.     }
  4354.  
  4355. }
  4356.  
  4357.  
  4358. ###############################################################################
  4359. # all the code to handle the report writing dialog.
  4360. ###############################################################################
  4361.  
  4362. proc write-report {command args} {
  4363.     global g
  4364.     global w
  4365.     global report
  4366.     global finfo
  4367.  
  4368.     set w(reportPopup) .reportPopup
  4369.     switch $command {
  4370.         popup {
  4371.             if {![winfo exists $w(reportPopup)]} {
  4372.                 write-report build
  4373.             }
  4374.             set report(filename) [file join [pwd] $report(filename)]
  4375.             write-report update
  4376.  
  4377.             centerWindow $w(reportPopup)
  4378.             wm deiconify $w(reportPopup)
  4379.             raise $w(reportPopup)
  4380.         }
  4381.  
  4382.         cancel {
  4383.             wm withdraw $w(reportPopup)
  4384.         }
  4385.  
  4386.         update {
  4387.  
  4388.             set stateLeft  "disabled"
  4389.             set stateRight "disabled"
  4390.             if {$report(doSideLeft)} {set stateLeft "normal"}
  4391.             if {$report(doSideRight)} {set stateRight "normal"}
  4392.  
  4393.             $w(reportLinenumLeft) configure -state $stateLeft
  4394.             $w(reportCMLeft)      configure -state $stateLeft
  4395.             $w(reportTextLeft)    configure -state $stateLeft
  4396.  
  4397.             $w(reportLinenumRight) configure -state $stateRight
  4398.             $w(reportCMRight)      configure -state $stateRight
  4399.             $w(reportTextRight)    configure -state $stateRight
  4400.  
  4401.         }
  4402.  
  4403.         save {
  4404.             set leftLines  [lindex [split [$w(LeftText) index end-1lines] .] 0]
  4405.             set rightLines [lindex [split [$w(RightText) index end-1lines] .] 0]
  4406.  
  4407.             # number of lines of the largest window...
  4408.             set maxlines [max $leftLines $rightLines]
  4409.  
  4410.             # probably ought to catch this, in case it fails. Maybe later...
  4411.             set handle [open $report(filename) w]
  4412.  
  4413.             puts $handle "$g(name) $g(version) report"
  4414.  
  4415.             # write the file names
  4416.             if {$report(doSideLeft) == 1 && $report(doSideRight) == 1} {
  4417.                 puts $handle "\nFile A: $finfo(lbl,1)\nFile B: $finfo(lbl,2)\n"
  4418.             } elseif {$report(doSideLeft) == 1} {
  4419.                 puts $handle "\nFile: $finfo(lbl,1)"
  4420.             } else {
  4421.                 puts $handle "\nFile: $finfo(lbl,2)"
  4422.             }
  4423.  
  4424.             puts $handle "number of diffs: $g(count)"
  4425.  
  4426.             set acount [set ccount [set dcount 0]]
  4427.             for {set i 1} {$i <= $g(count)} {incr i} {
  4428. #                scan $g(scrdiff,$i) "%s %d %d %d %d %s" line s1 e1 s2 e2 type
  4429.                 foreach {line s1 e1 s2 e2 type} $g(scrdiff,$i) {}
  4430.                 switch $type {
  4431.                     "d" { incr dcount }
  4432.                     "a" { incr acount }
  4433.                     "c" { incr ccount }
  4434.                 }
  4435.             }
  4436.  
  4437.             puts $handle [format "    %6d regions were deleted" $dcount]
  4438.             puts $handle [format "    %6d regions were added"   $acount]
  4439.             puts $handle [format "    %6d regions were changed" $ccount]
  4440.  
  4441.             puts $handle "\n"
  4442.             for {set i 1} {$i <= $maxlines} {incr i} {
  4443.                 set out(Left) [set out(Right) ""]
  4444.                 foreach side {Left Right} {
  4445.  
  4446.                     if {$side == "Left"  && $i > $leftLines} break;
  4447.                     if {$side == "Right" && $i > $rightLines} break;
  4448.  
  4449.                     if {$report(doLineNumbers$side)} {
  4450.                         set widget $w(${side}Info)
  4451.                         set number [string trimright \
  4452.                                 [$widget get "$i.0" "$i.0 lineend"]]
  4453.  
  4454.                         append out($side) [format "%6s " $number]
  4455.                     }
  4456.  
  4457.                     if {$report(doChangeMarkers$side)} {
  4458.                         set widget $w(${side}CB)
  4459.                         set data [$widget get "$i.0" "$i.1"]
  4460.                         append out($side) "$data "
  4461.                     }
  4462.  
  4463.                     if {$report(doText$side)} {
  4464.                         set widget $w(${side}Text)
  4465.                         append out($side) [string trimright \
  4466.                                 [$widget get "$i.0" "$i.0 lineend"]]
  4467.                     }
  4468.                 }
  4469.  
  4470.                 if {$report(doSideLeft) == 1 && $report(doSideRight) == 1} {
  4471.                     set output [format "%-90s%-90s" $out(Left) $out(Right)]
  4472.  
  4473.                 } elseif {$report(doSideRight) == 1} {
  4474.                     set output $out(Right)
  4475.  
  4476.                 } elseif {$report(doSideLeft) == 1} {
  4477.                     set output $out(Left)
  4478.  
  4479.                 } else {
  4480.                     # what a wasted effort!
  4481.                     set output ""
  4482.                 }
  4483.                 puts $handle [string trimright $output]
  4484.             }
  4485.             close $handle
  4486.  
  4487.             wm withdraw $w(reportPopup)
  4488.         }
  4489.  
  4490.         browse {
  4491.             set types {
  4492.                 {{All Files}     {*}}
  4493.             }
  4494.  
  4495.             set path [tk_getSaveFile \
  4496.                     -defaultextension "" \
  4497.                     -filetypes $types \
  4498.                     -initialfile $report(filename)]
  4499.  
  4500.             if {[string length $path] > 0} {
  4501.                 set report(filename) $path
  4502.             }
  4503.         }
  4504.  
  4505.         build {
  4506.             catch {destroy $w(reportPopup)}
  4507.             toplevel $w(reportPopup)
  4508.             wm group $w(reportPopup) .
  4509.             wm transient $w(reportPopup) .
  4510.             wm title $w(reportPopup) "$g(name) - Generate Report"
  4511.             wm protocol $w(reportPopup) WM_DELETE_WINDOW \
  4512.                     [list write-report cancel]
  4513.             wm withdraw $w(reportPopup)
  4514.  
  4515.             set cf [frame $w(reportPopup).clientFrame -bd 2 -relief groove]
  4516.             set bf [frame $w(reportPopup).buttonFrame -bd 0]
  4517.             pack $cf -side top    -fill both -expand y -padx 5 -pady 5
  4518.             pack $bf -side bottom -fill x -expand n
  4519.  
  4520.             # buttons...
  4521.             set w(reportSave) $bf.save
  4522.             set w(reportCancel) $bf.cancel
  4523.  
  4524.             button $w(reportSave) \
  4525.                     -text "Save" \
  4526.                     -underline 0 \
  4527.                     -command [list write-report save] \
  4528.                     -width 6
  4529.             button $w(reportCancel) \
  4530.                     -text "Cancel" \
  4531.                     -underline 0 \
  4532.                     -command [list write-report cancel] \
  4533.                     -width 6
  4534.  
  4535.             pack $w(reportCancel) -side right -pady 5 -padx 5
  4536.             pack $w(reportSave)   -side right -pady 5
  4537.  
  4538.             # client area.
  4539.             set col(Left) 0; set col(Right) 1
  4540.             foreach side  [list Left Right] {
  4541.                 set choose  [checkbutton $cf.choose$side]
  4542.                 set linenum [checkbutton $cf.linenum$side]
  4543.                 set cm      [checkbutton $cf.changemarkers$side]
  4544.                 set text    [checkbutton $cf.text$side]
  4545.  
  4546.                 $choose configure \
  4547.                         -text "$side Side" \
  4548.                         -variable report(doSide$side) \
  4549.                         -command [list write-report update]
  4550.  
  4551.                 $linenum configure \
  4552.                         -text "Line Numbers" \
  4553.                         -variable report(doLineNumbers$side)
  4554.                 $cm configure \
  4555.                         -text "Change Markers" \
  4556.                         -variable report(doChangeMarkers$side)
  4557.                 $text configure \
  4558.                         -text "Text" \
  4559.                         -variable report(doText$side)
  4560.  
  4561.                 grid $choose  -row 0 -column $col($side) -sticky w
  4562.                 grid $linenum -row 1 -column $col($side) -sticky w -padx 10
  4563.                 grid $cm      -row 2 -column $col($side) -sticky w -padx 10
  4564.                 grid $text    -row 3 -column $col($side) -sticky w -padx 10
  4565.  
  4566.                 # save the widget paths for later use...
  4567.                 set w(reportChoose$side)  $choose
  4568.                 set w(reportLinenum$side) $linenum
  4569.                 set w(reportCM$side)      $cm
  4570.                 set w(reportText$side)    $text
  4571.             }
  4572.  
  4573.             # the entry, label and button for the filename will get
  4574.             # stuffed into a frame for convenience...
  4575.             frame $cf.fileFrame -bd 0
  4576.             grid $cf.fileFrame -row 4 -columnspan 2 -sticky ew -padx 5
  4577.  
  4578.             label $cf.fileFrame.l -text "File:"
  4579.             entry $cf.fileFrame.e \
  4580.                     -textvariable report(filename) \
  4581.                     -width 30
  4582.             button $cf.fileFrame.b \
  4583.                     -text "Browse..." \
  4584.                     -pady 0 \
  4585.                     -highlightthickness 0 \
  4586.                     -borderwidth 1 \
  4587.                     -command [list write-report browse]
  4588.  
  4589.             pack $cf.fileFrame.l -side left -pady 4
  4590.             pack $cf.fileFrame.b -side right -pady 4 -padx 2
  4591.             pack $cf.fileFrame.e -side left -fill x -expand y -pady 4
  4592.  
  4593.             grid rowconfigure $cf 0 -weight 0
  4594.             grid rowconfigure $cf 1 -weight 0
  4595.             grid rowconfigure $cf 2 -weight 0
  4596.             grid rowconfigure $cf 3 -weight 0
  4597.  
  4598.             grid columnconfigure $cf 0 -weight 1
  4599.             grid columnconfigure $cf 1 -weight 1
  4600.  
  4601.             # make sure the widgets are in the proper state
  4602.             write-report update
  4603.         }
  4604.     }
  4605. }
  4606.  
  4607. ###############################################################################
  4608. # Throw up an "about" window.
  4609. ###############################################################################
  4610.  
  4611. proc do-about {} {
  4612.     global g
  4613.  
  4614.     set title "About $g(name)"
  4615.     set text {
  4616. <hdr>$g(name) $g(version)</hdr>
  4617.  
  4618. <itl>$g(name)</itl> is a Tcl/Tk front-end to <itl>diff</itl> for Unix and NT, and is Copyright (C) 1994-1998 by John M. Klassa.
  4619.  
  4620. <bld>This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.
  4621.  
  4622. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  4623.  
  4624. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA</bld>
  4625.  
  4626.     }
  4627.  
  4628.     set text [subst -nobackslashes -nocommands $text]
  4629.     do-text-info .about $title $text
  4630. }
  4631.  
  4632. ###############################################################################
  4633. # Throw up a "command line usage" window.
  4634. ###############################################################################
  4635.  
  4636. proc do-usage {} {
  4637.     global g
  4638.  
  4639.     set title "The $g(name) Command Line"
  4640.     set text {
  4641. <hdr>Startup</hdr>
  4642.  
  4643. <itl>$g(name)</itl> may be started in any of the following ways:
  4644.  
  4645.     Interactive selection of files to compare:
  4646. <cmp>   tkdiff</cmp>
  4647.  
  4648.     Plain files:
  4649. <cmp>   tkdiff FILE1 FILE2</cmp>
  4650.  
  4651.     Plain file with conflict markers:
  4652. <cmp>   tkdiff -conflict FILE</cmp>
  4653.  
  4654.     Source control RCS/CVS/SCCS/PVCS/Perforce:
  4655. <cmp>   tkdiff FILE    </cmp>(same as -r)
  4656. <cmp>   tkdiff -r FILE
  4657.         tkdiff -rREV FILE
  4658.         tkdiff -rREV -r FILE
  4659.         tkdiff -rREV1 -rREV2 FILE</cmp>
  4660.  
  4661. $g(name) detects and supports RCS, CVS and SCCS by looking for a directory with the same name.  It detects and supports PVCS by looking for a vcs.cfg file. It detects and supports Perforce by looking for an environment variable named P4CLIENT.
  4662.  
  4663. In the first form, tkdiff will present a dialog to allow you to choose the files to diff interactively. At present this dialog only supports a diff between two files that already exist. There is no way to do a diff against a file under souce code control (unless the previous versions can be found on disk via a standard file selection dialog).
  4664.  
  4665. In the second form, at least one of the arguments must be the name of a plain text file.  Symbolic links are acceptable, but at least one of the filename arguments must point to a real file rather than to a directory.
  4666.  
  4667. In the remaining forms, <cmp>REV</cmp> (or <cmp>REV1</cmp> and <cmp>REV2</cmp>) must be a valid revision number for <cmp>FILE</cmp>.  Where RCS, CVS, SCCS, PVCS or Perforce is implied but no revision number is specified, <cmp>FILE</cmp> is compared with the the revision most recently checked in.
  4668.  
  4669. To merge a file with conflict markers generated by "<cmp>merge</cmp>", "<cmp>cvs</cmp>", or "<cmp>vmrg</cmp>", use "<cmp>tkdiff -conflict FILE</cmp>".  The file is split into two temporary files which you can merge as usual (see below).
  4670.  
  4671. Note that "<cmp>tkdiff FILE</cmp>" is the same as "<cmp>tkdiff -r FILE</cmp>".  The CVS version has priority, followed by the SCCS version -- i.e. if a CVS directory is present, CVS; if not and an SCCS directory is present, SCCS is assumed; otherwise, if a CVS.CFG file is found, PVCS is assumed; otherwise RCS is assumed. If none of the above apply and the Perforce environment variable P4CLIENT is found, perforce is used.
  4672.  
  4673. Note also that the "<cmp>tkdiff -rREV -r FILE</cmp>" form results in a comparison between revision <cmp>REV</cmp> and the head of the RCS, CVS, SCCS, PVCS or Perforce revision tree.
  4674. }
  4675.  
  4676.     set text [subst -nobackslashes -nocommands $text]
  4677.     do-text-info .usage $title $text
  4678. }
  4679.  
  4680. ###############################################################################
  4681. # Throw up a help window.
  4682. ###############################################################################
  4683.  
  4684. proc do-help {} {
  4685.     global g
  4686.  
  4687.     set title "How to use the $g(name) GUI"
  4688.     set text {
  4689. <hdr>Layout</hdr>
  4690.  
  4691. The top row contains the File, Edit, View, Merge and Help menus. The second row contains the labels which identify the contents of each text window. Below that is a toolbar which contains navigation and merge selection tools.
  4692.  
  4693. The left-most text widget displays the contents of <cmp>FILE1</cmp>, the most recently checked-in revision, <cmp>REV</cmp> or <cmp>REV1</cmp>, respectively (as per the startup options described in the "On Command Line" help). The right-most widget displays the contents of <cmp>FILE2</cmp>, <cmp>FILE</cmp> or <cmp>REV2</cmp>, respectively. Clicking the right mouse button over either of these windows will give you a context sensitive menu with actions that will act on the window you clicked over. For example, if you click right over the right hand window and select "Edit", the file displayed on the right hand side will be loaded into a text editor.
  4694.  
  4695. All difference regions (DRs) are highlighted to set them apart from the surrounding text. The <itl>current difference region</itl>, or <bld>CDR</bld>, is further set apart so that it can be correlated to its partner in the other text widget (that is, the CDR on the left matches the CDR on the right).
  4696.  
  4697. <hdr>Changing the CDR</hdr>
  4698.  
  4699. The CDR can be changed in a sequential manner by means of the <btn>Next</btn> and <btn>Previous</btn> buttons. The <btn>First</btn> and <btn>Last</btn> buttons allow you to quickly navigate to the first or last CDR, respectively. For random access to the DRs, use the dropdown listbox in the toolbar or the diff map, described below.
  4700.  
  4701. By clicking right over a window and using the popup menu you can select <btn>Find Nearest Diff</btn> to find the diff record nearest the point where you clicked.
  4702.  
  4703. You may also select any highlighted diff region as the current diff region by double-clicking on it.
  4704.  
  4705. <hdr>Operations</hdr>
  4706.  
  4707. 1. From the <btn>File</btn> menu:
  4708.  
  4709. The <btn>New...</btn> button displays a dialog where you may choose two files to compare. Selecting "Ok" from the dialog will diff the two files. The <btn>Recompute Diffs</btn> button recomputes the differences between the two files whose names appear at the top of the <itl>$g(name)</itl> window. The <btn>Write Report...</btn> lets you create a report file that contains the information visible in the windows. Lastly, the <btn>Exit</btn> button terminates <itl>$g(name)</itl>.
  4710.  
  4711. 2. From the <btn>Edit</btn> menu:
  4712.  
  4713. <btn>Copy</btn> copies the currently selected text to the system clipboard. <btn>Find</btn> pops up a dialog to let you search either text window for a specified text string.  <btn>Edit File 1</btn> and <btn>Edit File 2</btn> launch an editor on the files displayed in the left- and right-hand panes.  <btn>Preferences</btn> pops up a dialog box from which display (and other) options can be changed and saved.
  4714.  
  4715. 3. From the <btn>View</btn> menu:
  4716.  
  4717. <btn>Show Line Numbers</btn> toggles the display of line numbers in the text widgets. If <btn>Synchronize Scrollbars</btn> is on, the left and right text widgets are synchronized i.e. scrolling one of the windows scrolls the other. If <btn>Auto Center</btn> is on, pressing the Next or Prev buttons centers the new CDR automatically. The <btn>Show Diff Map</btn> toggles the display of the diff map (see below) on or off. <btn>Show Merge Preview</btn> shows or hides the merge preview (see below).
  4718.  
  4719. 4. From the <btn>Merge</btn> menu:
  4720.  
  4721. The <btn>Show Merge Window</btn> button pops up a window with the current merged version of the two files. The <btn>Write Merge File</btn> button will allow you to save the contents of that window to a file.
  4722.  
  4723. 5. From the <btn>Help</btn> menu:
  4724.  
  4725. The <btn>About $g(name)</btn> button displays copyright and author information. The <btn>On GUI</btn> button generates this window. The <btn>On Command Line</btn> button displays help on the $g(name) command line options. The <btn>On Preferences</btn> button displays help on the user-settable preferences.
  4726.  
  4727. 6. From the toolbar:
  4728.  
  4729. The first tool is a dropdown list of all of the differences in a standard diff-type format. You may use this list to go directly to any diff record. The <btn>Next</btn> and <btn>Previous</btn> buttons take you to the "next" and "previous" DR, respectively. The <btn>First</btn> and <btn>Last</btn> buttons take you to the "first" and "last" DR. The <btn>Center</btn> button centers the CDRs in their respective text windows. You can set <btn>Auto Center</btn> in <btn>Preferences</btn> to do this automatically for you as you navigate through the diff records.
  4730.  
  4731. <hdr>Keyboard Navigation</hdr>
  4732.  
  4733. When a text widget has the focus, you may use the following shortcut keys:
  4734. <cmp>
  4735.         f       First diff
  4736.         c       Center current diff
  4737.         l       Last diff
  4738.         n       Next diff
  4739.         p       Previous diff
  4740.         1       Merge Choice 1
  4741.         2       Merge Choice 2
  4742. </cmp>
  4743.  
  4744. The cursor, Home, End, PageUp and PageDown keys work as expected, adjusting the view in whichever text window has the focus. Note that if <btn>Synchronize Scrollbars</btn> is set in <btn>Preferences</btn>, both windows will scroll at the same time.
  4745.  
  4746. <hdr>Scrolling</hdr>
  4747.  
  4748. To scroll the text widgets independently, make sure <btn>Synchronize Scrollbars</btn> in <btn>Preferences</btn> is off. If it is on, scrolling any text widget scrolls all others. Scrolling does not change the current diff record (CDR).
  4749.  
  4750. <hdr>Diff Map</hdr>
  4751.  
  4752. The diff map is a map of all the diff regions. It is shown in the middle of the main window if "Diff Map" on the View menu is on. The map is a miniature of the file's diff regions from top to bottom. Each diff region is rendered as a patch of color, Delete as red, Insert as green and Change as blue. The height of each patch corresponds to the relative size of the diff region. A thumb lets you interact with the map as if it were a scrollbar.
  4753.  
  4754. All diff regions are drawn on the map even if too small to be visible. For large files with small diff regions, this may result in patches overwriting each other.
  4755.  
  4756. <hdr>Merging</hdr>
  4757.  
  4758. To merge the two files, go through the difference regions (via "Next", "Prev" or whatever other means you prefer) and select "Left" or "Right" (next to the "Merge Choice:" label) for each. Selecting "Left" means that the the left-most file's version of the difference will be used in creating the final result; choosing "Right" means that the right-most file's difference will be used. Each choice is recorded, and can be changed arbitrarily many times. To commit the final, merged result to disk, choose "Write Merge File" from the <btn>Merge</btn> menu.
  4759.  
  4760. <hdr>Merge Preview</hdr>
  4761.  
  4762. To see a preview of the file that would be written by "Write Merge File", select "Show Merge Window" in the View menu. A separate window is shown containing the preview. It is updated as you change merge choices. It is synchronized with the other text widgets if "Synchronize Scrollbars" is on.
  4763.  
  4764. <hdr>Credits</hdr>
  4765.  
  4766. Thanks to Wayne Throop for beta testing, and for giving valuable suggestions (and code!) along the way. Thanks (and credit) to John Heidemann for his window tags routines, which I shamelessly stole (with permission) out of his great Tk-based Solitaire game, <itl>Klondike</itl>. Thanks to D. Elson (author of <itl>tkCVS</itl>) for writing the code that extends the RCS support to include CVS. Thanks to John Brown for writing the code that extends the revision control support to SCCS.
  4767.  
  4768. <bld>Major</bld> thanks to Warren Jones (wjones@tc.fluke.com) and Peter Brandstrom (qraprbm@era-lvk.ericsson.se) for going way above and beyond the call. Warren added support for NT and cleaned up the Unix code as well. Peter, independently, did the same thing and then added the new interface. The end result was the 2.x series...  Many, many thanks to you both!
  4769.  
  4770. <bld>Major</bld> thanks also to Bryan Oakley (oakley@channelpoint.com), who made the GUI even more appealing...  Bryan did a <itl>ton</itl> of work, the result of which was the 3.x series.  Dorothy Robinson provided helpful comments and patches for 3.x, too.  Thanks, Bryan and Dorothy!
  4771.  
  4772.  
  4773. Many, many thanks also to the many others who have written and provided ideas and encouragement and code since <itl>$g(name)</itl> was first released!  I haven't done much coding since the 1.x series; almost every new feature that has come about since then has been the result of volunteer efforts.  Thanks, folks!
  4774.  
  4775. <hdr>Comments</hdr>
  4776.  
  4777. Questions and comments should be sent to John Klassa at <itl>klassa@ipass.net</itl>.
  4778.  
  4779.     }
  4780.  
  4781.     set text [subst -nobackslashes -nocommands $text]
  4782.     do-text-info .help $title $text
  4783. }
  4784.  
  4785. ######################################################################
  4786. # display help on the preferences
  4787. ######################################################################
  4788. proc do-help-preferences {} {
  4789.     global g
  4790.     global pref
  4791.  
  4792.     customize-initLabels
  4793.  
  4794.     set title "$g(name) Preferences"
  4795.     set text {
  4796. <hdr>Overview</hdr>
  4797.  
  4798. Preferences are stored in a file in your home directory (identified by the environment variable <cmp>HOME</cmp>. If the environment variable <cmp>HOME</cmp> is not set the platform-specific variant of "/" will be used. If you are on a Windows platform the file will be named <cmp>_tkdiff.rc</cmp> and will have the attribute "hidden". For all other platforms the file will be named ".tkdiffrc". You may override the name and location of this file  by setting the environment variable <cmp>TKDIFFRC</cmp> to whatever filename you wish.
  4799.  
  4800. Preferences are organized into three categories: General, Display and Appearance.
  4801.  
  4802. <hdr>General</hdr>
  4803.  
  4804. <bld>$pref(diffcmd)</bld>
  4805.  
  4806. This is the command (with arguments) to run to generate a diff of the two files. Typically this will be "diff". If you are using gnu diff you might want to set it to "diff --ignore-space-change" to ignore changes in whitespace. When this command is run, the names of two files to be diffed will be added as the last to arguments on the command line.
  4807.  
  4808.  
  4809. <bld>$pref(tmpdir)</bld>
  4810.  
  4811. The name of a directory for files that are temporarily created while $g(name) is running.
  4812.  
  4813.  
  4814. <bld>$pref(editor)</bld>
  4815.  
  4816. The name of an external editor program to use when editing a file (ie: when you select "Edit" from the popup menu). If this value is blank, a simple editor built in to $g(name) will be used. For windows users you might want to set this to "notepad". Unix users may want to set this to "xterm -e vi" or perhaps "gnuclient". When run, the name of the file to edit will be appened as the last argument on the command line.
  4817.  
  4818. <bld>$pref(geometry)</bld>
  4819.  
  4820. This defines the default size, in characters of the two text windows. The format should be <cmp>WIDTHxHEIGHT</cmp>. For example, "80x40".
  4821.  
  4822.  
  4823. <bld>$pref(fancyButtons)</bld>
  4824.  
  4825. If set, toolbar buttons will mimic the visual behavior of typical Microsoft Windows applications. Buttons will initially be flat until the cursor moves over them, at which time they will be raised.
  4826.  
  4827. If unset, toolbar buttons will always appear raised.
  4828.  
  4829.  
  4830. <bld>$pref(autocenter)</bld>
  4831.  
  4832. If set, whenever a new diff record becomes the current diff record (for example, when pressing the next or previous buttons), the diff record will be automatically centered on the screen.
  4833.  
  4834. If unset, no automatic scrolling will occur.
  4835.  
  4836.  
  4837. <bld>$pref(syncscroll)</bld>
  4838.  
  4839. If set, scrolling either text window will result in both windows scrolling.
  4840.  
  4841. If not set, the windows will scroll independent of each other.
  4842.  
  4843.  
  4844. <bld>$pref(autoselect)</bld>
  4845.  
  4846. If set, automatically select the nearest visible diff region when scrolling.
  4847.  
  4848. If not set, the current diff region will not change during scrolling.
  4849.  
  4850. This only takes effect if <bld>$pref(syncscroll)</bld> is set.
  4851.  
  4852.  
  4853. <hdr>Display</hdr>
  4854.  
  4855. <bld>$pref(showln)</bld>
  4856.  
  4857. If set, line numbers will be displayed alongside each line of each file.
  4858.  
  4859. If not set, no line numbers will appear.
  4860.  
  4861.  
  4862. <bld>$pref(tagln)</bld>
  4863.  
  4864. If set, line numbers are highlighted with the options defined in the Appearance section of the preferences.
  4865.  
  4866. If not set, line numbers won't be highlighted.
  4867.  
  4868.  
  4869. <bld>$pref(showcbs)</bld>
  4870.  
  4871. If set, change bars will be displayed alongside each line of each file.
  4872.  
  4873. If not set, no change bars will appear.
  4874.  
  4875.  
  4876. <bld>$pref(tagcbs)</bld>
  4877.  
  4878. If set, change indicators will be highlighted. If <itl>$pref(colorcbs)</itl> is set they will appear as solid colored bars that match the colors used in the diff map. If <itl>$pref(colorcbs)</itl> is not set, the change indicators will be highlighted according to the options defined in the Appearance section of preferences.
  4879.  
  4880.  
  4881. <bld>$pref(showmap)</bld>
  4882.  
  4883. If set, colorized, graphical "diff map" will be displayed between the two files, showing regions that have changed. Red is used to show deleted lines, green for added lines, and blue for changed lines.
  4884.  
  4885. If not set, the diff map will not be shown.
  4886.  
  4887.  
  4888. <bld>$pref(tagtext)</bld>
  4889.  
  4890. If set, the file contents will be highlighted with the options defined in the Appearance section of the preferences.
  4891.  
  4892. If not set, the file contents won't be highlighted.
  4893.  
  4894.  
  4895. <bld>$pref(colorcbs)</bld>
  4896.  
  4897. If set, the change bars will display as solid bars of color that match the colors used by the diff map.
  4898.  
  4899. If not set, the change bars will display a "+" for lines that exist in only one file, a "-" for lines that are missing from only one file, and "!" for lines that are different between the two files.
  4900.  
  4901.  
  4902.  
  4903. <hdr>Appearance</hdr>
  4904.  
  4905. <bld>$pref(textopt)</bld>
  4906.  
  4907. This is a list of Tk text widget options that are applied to each of the two text windows in the main display. If you have Tk installed on your machine these will be documented in the "Text.n" man page.
  4908.  
  4909.  
  4910. <bld>$pref(difftag)</bld>
  4911.  
  4912. This is a list of Tk text widget tag options that are applied to all diff regions. Use this option to make diff regions stand out from regular text.
  4913.  
  4914.  
  4915. <bld>$pref(deltag)</bld>
  4916.  
  4917. This is a list of Tk text widget tag options that are applied to the current diff region. These options have a higher priority than those for all diff regions. So, for example, if you set the forground for all diff regions to be black and set the foreground for the current diff region to be blue, the current diff region foreground color will be used.
  4918.  
  4919.  
  4920. <bld>$pref(instag)</bld>
  4921.  
  4922. This is a list of Tk text widget tag options that are applied to regions that have been inserted. These options have a higher priority than those for all diff regions.
  4923.  
  4924.  
  4925. <bld>$pref(chgtag)</bld>
  4926.  
  4927. This is a list of Tk text widget tag options that are applied to regions that have been changed. These options have a higher priority than those for all diff regions.
  4928.  
  4929.  
  4930. <bld>$pref(currtag)</bld>
  4931.  
  4932. This is a list of Tk text widget tag options that are applied to the current diff region. These tags have a higher priority than those for all diff regions, and a higher priority than the change, inserted and deleted diff regions.
  4933.  
  4934.  
  4935.  
  4936.     }
  4937.  
  4938.     # since we have embedded references to the preference labels in
  4939.     # the text, we need to perform substitutions. Because of this, if
  4940.     # you edit the above text, be sure to properly escape any dollar
  4941.     # signs that are not meant to be treated as a variable reference
  4942.  
  4943.     set text [subst -nobackslashes -nocommands $text]
  4944.     do-text-info .help-preferences $title $text
  4945. }
  4946.  
  4947. ######################################################################
  4948. #
  4949. # text formatting routines derived from Klondike
  4950. # Reproduced here with permission from their author.
  4951. #
  4952. # Copyright (C) 1993,1994 by John Heidemann <johnh@ficus.cs.ucla.edu>
  4953. # All rights reserved.
  4954. #
  4955. # Redistribution and use in source and binary forms, with or without
  4956. # modification, are permitted provided that the following conditions
  4957. # are met:
  4958. # 1. Redistributions of source code must retain the above copyright
  4959. #    notice, this list of conditions and the following disclaimer.
  4960. # 2. Redistributions in binary form must reproduce the above copyright
  4961. #    notice, this list of conditions and the following disclaimer in the
  4962. #    documentation and/or other materials provided with the distribution.
  4963. # 3. The name of John Heidemann may not be used to endorse or promote products
  4964. #    derived from this software without specific prior written permission.
  4965. #
  4966. # THIS SOFTWARE IS PROVIDED BY JOHN HEIDEMANN ``AS IS'' AND
  4967. # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  4968. # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  4969. # ARE DISCLAIMED.  IN NO EVENT SHALL JOHN HEIDEMANN BE LIABLE
  4970. # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  4971. # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  4972. # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  4973. # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  4974. # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  4975. # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  4976. # SUCH DAMAGE.
  4977. #
  4978. ######################################################################
  4979.  
  4980. proc put-text {tw txt} {
  4981.     global tk_version
  4982.  
  4983.     if {$tk_version >= 8.0} {
  4984.         $tw configure -font {Helvetica 10}
  4985.  
  4986.         $tw tag configure bld -font {Helvetica 10 bold}
  4987.         $tw tag configure cmp -font {Courier 10 bold}
  4988.         $tw tag configure hdr -font {Helvetica 14 bold} -underline 1
  4989.         $tw tag configure itl -font {Times 10 italic}
  4990.  
  4991.         $tw tag configure btn \
  4992.             -font {Courier 9} \
  4993.             -foreground black -background white \
  4994.             -relief groove -borderwidth 2
  4995.  
  4996.         $tw tag configure ttl \
  4997.                 -font {Helvetica 14 italic} \
  4998.                 -foreground blue \
  4999.                 -justify center
  5000.  
  5001.     } else {
  5002.         $tw configure -font -*-Helvetica-Medium-R-Normal-*-14-*
  5003.  
  5004.         $tw tag configure bld -font -*-Helvetica-Bold-R-Normal-*-14-*
  5005.         $tw tag configure cmp -font -*-Courier-Medium-R-Normal-*-14-*
  5006.         $tw tag configure hdr -font -*-Helvetica-Bold-R-Normal-*-18-* \
  5007.             -underline 1
  5008.         $tw tag configure itl -font -*-Times-Medium-I-Normal-*-14-*
  5009.  
  5010.         $tw tag configure btn \
  5011.             -font -*-Courier-Medium-R-Normal-*-12-* \
  5012.             -foreground black -background white \
  5013.             -relief groove -borderwidth 2
  5014.  
  5015.         $tw tag configure ttl \
  5016.                 -font -*-Helvetica-Bold-R-Normal-*-18-* \
  5017.                 -foreground blue \
  5018.                 -justify center
  5019.  
  5020.     }
  5021.     $tw tag configure rev -foreground white -background black
  5022.  
  5023.     $tw mark set insert 0.0
  5024.  
  5025.     set t $txt
  5026.  
  5027.     while {[regexp -indices {<([^@>]*)>} $t match inds] == 1} {
  5028.  
  5029.         set start [lindex $inds 0]
  5030.         set end [lindex $inds 1]
  5031.         set keyword [string range $t $start $end]
  5032.  
  5033.         set oldend [$tw index end]
  5034.  
  5035.         $tw insert end [string range $t 0 [expr $start - 2]]
  5036.  
  5037.         purge-all-tags $tw $oldend insert
  5038.  
  5039.         if {[string range $keyword 0 0] == "/"} {
  5040.             set keyword [string trimleft $keyword "/"]
  5041.             if {[info exists tags($keyword)] == 0} {
  5042.                 error "end tag $keyword without beginning"
  5043.             }
  5044.             $tw tag add $keyword $tags($keyword) insert
  5045.             unset tags($keyword)
  5046.         } else {
  5047.             if {[info exists tags($keyword)] == 1} {
  5048.                 error "nesting of begin tag $keyword"
  5049.             }
  5050.             set tags($keyword) [$tw index insert]
  5051.         }
  5052.  
  5053.         set t [string range $t [expr $end + 2] end]
  5054.     }
  5055.  
  5056.     set oldend [$tw index end]
  5057.     $tw insert end $t
  5058.     purge-all-tags $tw $oldend insert
  5059. }
  5060.  
  5061. proc purge-all-tags {w start end} {
  5062.     foreach tag [$w tag names $start] {
  5063.         $w tag remove $tag $start $end
  5064.     }
  5065. }
  5066.  
  5067. proc do-edit {} {
  5068.     global g
  5069.     global opts
  5070.     global finfo
  5071.     global w
  5072.  
  5073.     if {$g(activeWindow) == $w(LeftText)} {
  5074.         set fileno 1
  5075.     } elseif {$g(activeWindow) == $w(RightText)} {
  5076.         set fileno 2
  5077.     } else {
  5078.         set fileno 1
  5079.     }
  5080.  
  5081.     if {$finfo(tmp,$fileno)} {
  5082.         do-error "This file is not editable."
  5083.     } else {
  5084.         if {[string length [string trim $opts(editor)]] == 0} {
  5085.             simpleEd open $finfo(pth,$fileno)
  5086.         } else {
  5087.             eval exec $opts(editor) "{$finfo(pth,$fileno)}" &
  5088.         }
  5089.     }
  5090. }
  5091.  
  5092.  
  5093. ##########################################################################
  5094. # A simple editor, from Bryan Oakley.
  5095. ##########################################################################
  5096. proc simpleEd {command args} {
  5097.     global font
  5098.  
  5099.     switch $command {
  5100.         open {
  5101.             set filename [lindex $args 0]
  5102.  
  5103.             set w .editor
  5104.             set count 0
  5105.             while {[winfo exists ${w}$count]} {
  5106.                 incr count 1
  5107.             }
  5108.             set w ${w}$count
  5109.  
  5110.             toplevel $w -borderwidth 2 -relief sunken
  5111.             wm title $w "$filename - Simple Editor"
  5112.             wm group $w .
  5113.  
  5114.             menu $w.menubar
  5115.             $w configure -menu $w.menubar
  5116.  
  5117.             $w.menubar add cascade -label "File" -menu $w.menubar.fileMenu
  5118.             $w.menubar add cascade -label "Edit" -menu $w.menubar.editMenu
  5119.  
  5120.             menu $w.menubar.fileMenu
  5121.             menu $w.menubar.editMenu
  5122.  
  5123.             $w.menubar.fileMenu add command -label "Save" \
  5124.                     -underline 1 -command [list simpleEd save $filename $w]
  5125.             $w.menubar.fileMenu add command -label "Save As..." \
  5126.                     -underline 1 -command [list simpleEd saveAs $filename $w]
  5127.             $w.menubar.fileMenu add separator
  5128.             $w.menubar.fileMenu add command -label "Exit" \
  5129.                     -underline 1 -command [list simpleEd exit $w]
  5130.  
  5131.             $w.menubar.editMenu add command -label "Cut" \
  5132.                     -command [list event generate $w.text <<Cut>>]
  5133.             $w.menubar.editMenu add command -label "Copy" \
  5134.                     -command [list event generate $w.text <<Copy>>]
  5135.             $w.menubar.editMenu add command -label "Paste" \
  5136.                     -command [list event generate $w.text <<Paste>>]
  5137.  
  5138.             text $w.text -wrap none \
  5139.                     -xscrollcommand [list $w.hsb set] \
  5140.                     -yscrollcommand [list $w.vsb set] \
  5141.                     -borderwidth 0 -font $font
  5142.             scrollbar $w.vsb -orient vertical -command [list $w.text yview]
  5143.             scrollbar $w.hsb -orient horizontal -command [list $w.text xview]
  5144.  
  5145.             grid $w.text -row 0 -column 0 -sticky nsew
  5146.             grid $w.vsb  -row 0 -column 1 -sticky ns
  5147.             grid $w.hsb  -row 1 -column 0 -sticky ew
  5148.  
  5149.             grid columnconfigure $w 0 -weight 1
  5150.             grid columnconfigure $w 1 -weight 0
  5151.             grid rowconfigure    $w 0 -weight 1
  5152.             grid rowconfigure    $w 1 -weight 0
  5153.  
  5154.             set fd [open $filename]
  5155.             $w.text insert 1.0 [read $fd]
  5156.             close $fd
  5157.         }
  5158.  
  5159.         save {
  5160.             set filename [lindex $args 0]
  5161.             set w [lindex $args 1]
  5162.             set fd [open $filename w]
  5163.             puts $fd [$w.text get 1.0 "end-1c"]
  5164.             close $fd
  5165.         }
  5166.  
  5167.         saveAs {
  5168.             set filename [lindex $args 0]
  5169.             set w [lindex $args 1]
  5170.             set filename [tk_getSaveFile -initialfile $filename]
  5171.             if {$filename != ""} {
  5172.                 simpleEd save $filename $w
  5173.             }
  5174.         }
  5175.  
  5176.         exit {
  5177.             set w [lindex $args 0]
  5178.             destroy $w
  5179.         }
  5180.     }
  5181.  
  5182. }
  5183.  
  5184. # end of simpleEd
  5185.  
  5186. #################################################################
  5187. # combobox.tcl reproduced here with permission from its author.
  5188. #################################################################
  5189. # Copyright (c) 1998, Bryan Oakley
  5190. # All Rights Reservered
  5191. #
  5192. # Bryan Oakley
  5193. # oakley@channelpoint.com
  5194. #
  5195. # combobox v1.07 October 9, 1998
  5196. #
  5197. # a combobox / dropdown listbox (pick your favorite name) widget
  5198. # written in pure tcl
  5199. #
  5200. # this code is freely distributable without restriction, but is
  5201. # provided as-is with no waranty expressed or implied.
  5202. #
  5203. # thanks to the following people who provided beta test support or
  5204. # patches to the code (in no particular order):
  5205. #
  5206. # Scott Beasley     Alexandre Ferrieux      Todd Helfter
  5207. # Matt Gushee       Laurent Duperval        John Jackson
  5208. # Fred Rapp         Christopher Nelson
  5209. # Eric Galluzzo     Jean-Francois Moine
  5210.  
  5211. # A special thanks to Martin M. Hunt who provided several good ideas,
  5212. # and always with a patch to implement them. Jean-Francois Moine,
  5213. # Todd Helfter and John Jackson were also kind enough to send in some
  5214. # code patches.
  5215.  
  5216. package require Tk 8.0
  5217. package provide combobox 1.07
  5218.  
  5219. namespace eval ::combobox {
  5220.  
  5221.     # this is the public interface
  5222.     namespace export combobox
  5223.  
  5224.     # get the scrollbar width. Because we try to be clever and draw our
  5225.     # own button instead of using a tk widget, we need to know what size
  5226.     # button to create. This little hack tells us the width of a scroll
  5227.     # bar.
  5228.     #
  5229.     # NB: we need to be sure and pick a window  that doesn't already
  5230.     # exist...
  5231.     set sbtest ".sbtest"
  5232.     set count 0
  5233.     while {[winfo exists $sbtest]} {
  5234.         set sbtest ".sbtest$count"
  5235.     }
  5236.     scrollbar $sbtest
  5237.     set sb_width [winfo reqwidth $sbtest]
  5238.     destroy $sbtest
  5239.  
  5240.     # the image used for the button...
  5241.     image create bitmap ::combobox::bimage -data  {
  5242.         #define down_arrow_width 15
  5243.         #define down_arrow_height 15
  5244.         static char down_arrow_bits[] = {
  5245.             0x00,0x80,0x00,0x80,0x00,0x80,0x00,0x80,
  5246.             0x00,0x80,0xf8,0x8f,0xf0,0x87,0xe0,0x83,
  5247.             0xc0,0x81,0x80,0x80,0x00,0x80,0x00,0x80,
  5248.             0x00,0x80,0x00,0x80,0x00,0x80
  5249.         }
  5250.     }
  5251. }
  5252.  
  5253. # this is the command that gets exported, and creates a new
  5254. # combobox widget. It works like other widget commands in that
  5255. # it takes as its first argument a widget path, and any remaining
  5256. # arguments are option/value pairs for the widget
  5257. proc ::combobox::combobox {w args} {
  5258.  
  5259.     # build it...
  5260.     eval build $w $args
  5261.  
  5262.     # set some bindings...
  5263.     setBindings $w
  5264.  
  5265.     # and we are done!
  5266.     return $w
  5267. }
  5268.  
  5269.  
  5270. # builds the combobox...
  5271. proc ::combobox::build {w args } {
  5272.     if {[winfo exists $w]} {
  5273.         error "window name \"$w\" already exists"
  5274.     }
  5275.  
  5276.     # create the namespace for this instance, and define a few
  5277.     # variables
  5278.     namespace eval ::combobox::$w {
  5279.  
  5280.         variable ignoreTrace 0
  5281.         variable oldFocus    {}
  5282.         variable oldGrab     {}
  5283.         variable oldValue    {}
  5284.         variable options
  5285.         variable this
  5286.         variable widgets
  5287.  
  5288.     }
  5289.  
  5290.     # import the widgets and options arrays into this proc so
  5291.     # we don't have to use fully qualified names, which is a
  5292.     # pain.
  5293.     upvar ::combobox::${w}::widgets widgets
  5294.     upvar ::combobox::${w}::options options
  5295.  
  5296.     # we need these to be defined, regardless if the user defined
  5297.     # them for us or not...
  5298.     array set options [list \
  5299.             -height       0 \
  5300.             -maxheight    10 \
  5301.             -command      {} \
  5302.             -image        {} \
  5303.             -textvariable {} \
  5304.             -editable     1 \
  5305.             -commandstate normal \
  5306.             -state          normal \
  5307.             -xscrollcommand {} \
  5308.     ]
  5309.  
  5310.     # this lets us reference the actual widget name from within
  5311.     # the namespace of the widget.
  5312.     namespace eval ::combobox::$w "set this $w"
  5313.  
  5314.     # the basic, always-visible parts of the combobox. We do these
  5315.     # here, because we want to query some of them for their default
  5316.     # values, which we want to juggle to other widgets. I suppose
  5317.     # I could use the options database, but for simplicity I choose
  5318.     # not to...
  5319.     set widgets(this)   [frame  $w -class Combobox -takefocus 0]
  5320.     set widgets(entry)  [entry  $w.entry -takefocus 1]
  5321.     set widgets(button) [label  $w.button -takefocus 0]
  5322.  
  5323.     # we will later rename the frame's widget proc to be our
  5324.     # own custom widget proc. We need to keep track of this
  5325.     # new name, so we'll define and store it here...
  5326.     set widgets(frame) ::combobox::${w}::$w
  5327.  
  5328.     # gotta do this sooner or later. Might as well do it now
  5329.     pack $widgets(entry)  -side left  -fill both -expand yes
  5330.     pack $widgets(button) -side right -fill y    -expand no
  5331.  
  5332.     # now, steal some attributes from the entry widget and store
  5333.     # them in our own options array
  5334.     foreach option [list -background -foreground -relief \
  5335.             -borderwidth -highlightthickness -highlightbackground \
  5336.             -font -width -selectbackground -selectborderwidth \
  5337.             -selectforeground -takefocus] {
  5338.         set options($option) [$widgets(entry) cget $option]
  5339.     }
  5340.  
  5341.     # I should probably do this in a catch, but for now it's
  5342.     # good enough... What it does, obviously, is put all of
  5343.     # the option/values pairs into an array. Make them easier
  5344.     # to handle later on...
  5345.     array set options $args
  5346.  
  5347.     # now, the dropdown list... the same renaming nonsense
  5348.     # must go on here as well...
  5349.     set widgets(popup)   [toplevel  $w.top]
  5350.     set widgets(listbox) [listbox   $w.top.list]
  5351.     set widgets(vsb)     [scrollbar $w.top.vsb]
  5352.  
  5353.     pack $widgets(listbox) -side left -fill both -expand y
  5354.  
  5355.     # fine tune the widgets based on the options (and a few
  5356.     # arbitrary values...)
  5357.  
  5358.     # NB: we are going to use the frame to handle the relief
  5359.     # of the widget as a whole, so the entry widget will be
  5360.     # flat. This makes the button which drops down the list
  5361.     # to appear "inside" the entry widget.
  5362.  
  5363.     $widgets(vsb) configure \
  5364.             -command "$widgets(listbox) yview" \
  5365.             -highlightthickness 0
  5366.  
  5367.     $widgets(button) configure \
  5368.             -highlightthickness 0 \
  5369.             -borderwidth 1 \
  5370.             -relief raised \
  5371.             -width [expr {[winfo reqwidth $widgets(vsb)] - 2}]
  5372.  
  5373.     $widgets(entry) configure \
  5374.             -borderwidth 0 \
  5375.             -relief flat \
  5376.             -textvariable ::combobox::${w}::entryTextVariable \
  5377.             -highlightthickness 0
  5378.  
  5379.     $widgets(popup) configure \
  5380.             -borderwidth 1 \
  5381.             -relief sunken
  5382.  
  5383.     $widgets(listbox) configure \
  5384.             -selectmode browse \
  5385.             -background [$widgets(entry) cget -bg] \
  5386.             -yscrollcommand "$widgets(vsb) set" \
  5387.             -borderwidth 0
  5388.  
  5389.  
  5390.     trace variable ::combobox::${w}::entryTextVariable w \
  5391.             [list ::combobox::entryTrace $w]
  5392.  
  5393.     # do some window management foo on the dropdown window
  5394.     wm overrideredirect $widgets(popup) 1
  5395.     wm transient        $widgets(popup) [winfo toplevel $w]
  5396.     wm group            $widgets(popup) [winfo parent $w]
  5397.     wm resizable        $widgets(popup) 0 0
  5398.     wm withdraw         $widgets(popup)
  5399.  
  5400.     # this moves the original frame widget proc into our
  5401.     # namespace and gives it a handy name
  5402.     rename ::$w $widgets(frame)
  5403.  
  5404.     # now, create our widget proc. Obviously (?) it goes in
  5405.     # the global namespace. All combobox widgets will actually
  5406.     # share the same widget proc to cut down on the amount of
  5407.     # bloat.
  5408.     proc ::$w {command args} \
  5409.             "eval ::combobox::widgetProc $w \$command \$args"
  5410.  
  5411.     # ok, the thing exists... let's do a bit more configuration.
  5412.     foreach opt [array names options] {
  5413.         ::combobox::configure $widgets(this) set $opt $options($opt)
  5414.     }
  5415.  
  5416.  
  5417. }
  5418.  
  5419. # this is called whenever the contents of the entry widget changes;
  5420. # it's main purpose is to update the public textvariable, if
  5421. # any
  5422. proc ::combobox::entryTrace {w args} {
  5423.     upvar ::combobox::${w}::options options
  5424.     upvar ::combobox::${w}::ignoreTrace ignoreTrace
  5425.  
  5426.     if {[string length $options(-textvariable)]} {
  5427.         set ignoreTrace 1
  5428.         uplevel \#0 [list set $options(-textvariable) \
  5429.                 [set ::combobox::${w}::entryTextVariable]]
  5430.         unset ignoreTrace
  5431.     }
  5432. }
  5433.  
  5434. # here's where we do most of the binding foo. I think there's probably
  5435. # a few bindings I ought to add that I just haven't thought about...
  5436. #
  5437. # I'm not convinced these are the proper bindings. Ideally all bindings
  5438. # should be on "Combobox", but because of my juggling of bindtags I'm
  5439. # not convinced thats what I want to do. But, it all seems to work, its
  5440. # just not as robust as it could be.
  5441. proc ::combobox::setBindings {w} {
  5442.     namespace eval ::combobox::$w {
  5443.         variable widgets
  5444.         variable options
  5445.  
  5446.         # juggle the bindtags. The basic idea here is to associate the
  5447.         # widget name with the entry widget, so if a user does a bind
  5448.         # on the combobox it will get handled properly since it is
  5449.         # the entry widget that has keyboard focus.
  5450.         bindtags $widgets(entry) \
  5451.                 [concat $widgets(this) [bindtags $widgets(entry)]]
  5452.  
  5453.         bindtags $widgets(button) \
  5454.                 [concat $widgets(this) [bindtags $widgets(button)]]
  5455.  
  5456.         # make sure we clean up after ourselves...
  5457.         bind $widgets(entry) <Destroy> [list ::combobox::destroyHandler $this]
  5458.  
  5459.         # this closes the listbox if we get hidden
  5460.         bind $widgets(this) <Unmap> "$widgets(this) close"
  5461.  
  5462.         # this helps (but doesn't fully solve) focus issues. The general
  5463.         # idea is, whenever the frame gets focus it gets passed on to
  5464.         # the entry widget
  5465.         bind $widgets(this) <FocusIn> \
  5466.                 "tkTabToWindow $widgets(entry)"
  5467.  
  5468.         # override the default bindings for tab and shift-tab. The
  5469.         # focus procs take a widget as their only parameter and we
  5470.         # want to make sure the right window gets used (for shift-
  5471.         # tab we want it to appear as if the event was generated
  5472.         # on the frame rather than the entry. I
  5473.  
  5474.         bind $widgets(entry) <Tab> \
  5475.                 "tkTabToWindow \[tk_focusNext $widgets(entry)\]; break"
  5476.         bind $widgets(entry) <Shift-Tab> \
  5477.                 "tkTabToWindow \[tk_focusPrev $widgets(this)\]; break"
  5478.  
  5479.         # this makes our "button" (which is actually a label)
  5480.         # do the right thing
  5481.         bind $widgets(button) <ButtonPress-1> [list $widgets(this) toggle]
  5482.  
  5483.         # this lets the autoscan of the listbox work, even if they
  5484.         # move the cursor over the entry widget.
  5485.         bind $widgets(entry) <B1-Enter> "break"
  5486.  
  5487.         # this will (hopefully) close (and lose the grab on) the
  5488.         # listbox if the user clicks anywhere outside of it. Note
  5489.         # that on Windows, you can click on some other app and
  5490.         # the listbox will still be there, because tcl won't see
  5491.         # that button click
  5492.         bind Combobox <Any-ButtonPress>  [list $widgets(this) close]
  5493.         bind Combobox <Any-ButtonRelease> [list $widgets(this) close]
  5494.  
  5495.         bind $widgets(listbox) <ButtonRelease-1> \
  5496.                 "::combobox::select $widgets(this) \[$widgets(listbox) nearest %y\]; break"
  5497.  
  5498.         bind $widgets(vsb) <ButtonPress-1> {continue}
  5499.         bind $widgets(vsb) <ButtonRelease-1> {continue}
  5500.  
  5501.         bind $widgets(listbox) <Any-Motion> {
  5502.             %W selection clear 0 end
  5503.             %W activate @%x,%y
  5504.             %W selection anchor @%x,%y
  5505.             %W selection set @%x,%y @%x,%y
  5506.             # need to do a yview if the cursor goes off the top
  5507.             # or bottom of the window... (or do we?)
  5508.         }
  5509.  
  5510.         # these events need to be passed from the entry
  5511.         # widget to the listbox, or need some sort of special
  5512.         # handling....
  5513.         foreach event [list <Up> <Down> <Tab> <Return> <Escape> \
  5514.                 <Next> <Prior> <Double-1> <1> <Any-KeyPress> \
  5515.                 <FocusIn> <FocusOut>] {
  5516.             bind $widgets(entry) $event \
  5517.                     "::combobox::handleEvent $widgets(this) $event"
  5518.         }
  5519.  
  5520.     }
  5521. }
  5522.  
  5523. # this proc handles events from the entry widget that we want handled
  5524. # specially (typically, to allow navigation of the list even though
  5525. # the focus is in the entry widget)
  5526. proc ::combobox::handleEvent {w event} {
  5527.     upvar ::combobox::${w}::widgets  widgets
  5528.     upvar ::combobox::${w}::options  options
  5529.     upvar ::combobox::${w}::oldValue oldValue
  5530.  
  5531.     # for all of these events, if we have a special action we'll
  5532.     # do that and do a "return -code break" to keep additional
  5533.     # bindings from firing. Otherwise we'll let the event fall
  5534.     # on through.
  5535.     switch $event {
  5536.  
  5537.         "<Any-KeyPress>" {
  5538.             # if the widget is editable, clear the selection.
  5539.             # this makes it more obvious what will happen if the
  5540.             # user presses <Return> (and helps our code know what
  5541.             # to do if the user presses return)
  5542.             if {$options(-editable)} {
  5543.                 $widgets(listbox) see 0
  5544.                 $widgets(listbox) selection clear 0 end
  5545.                 $widgets(listbox) selection anchor 0
  5546.                 $widgets(listbox) activate 0
  5547.             }
  5548.         }
  5549.  
  5550.         "<FocusIn>" {
  5551.             set oldValue [$widgets(entry) get]
  5552.         }
  5553.  
  5554.         "<FocusOut>" {
  5555.             if {[winfo ismapped $widgets(popup)]} {
  5556.                 return -code break
  5557.  
  5558.             } else {
  5559.                 # did the value change?
  5560.                 set newValue [set ::combobox::${w}::entryTextVariable]
  5561.                 if {$oldValue != $newValue} {
  5562.                     callCommand $widgets(this) $newValue
  5563.                 }
  5564.             }
  5565.         }
  5566.  
  5567.         "<1>" {
  5568.             set editable [::combobox::getBoolean $options(-editable)]
  5569.             if {!$editable} {
  5570.                 if {[winfo ismapped $widgets(popup)]} {
  5571.                     $widgets(this) close
  5572.                     return -code break;
  5573.  
  5574.                 } else {
  5575.                     if {$options(-state) != "disabled"} {
  5576.                         $widgets(this) open
  5577.                         return -code break;
  5578.                     }
  5579.                 }
  5580.             }
  5581.         }
  5582.  
  5583.         "<Double-1>" {
  5584.             if {$options(-state) != "disabled"} {
  5585.                 $widgets(this) toggle
  5586.                 return -code break;
  5587.             }
  5588.         }
  5589.  
  5590.         "<Tab>" {
  5591.             if {[winfo ismapped $widgets(popup)]} {
  5592.                 ::combobox::find $widgets(this)
  5593.                 return -code break;
  5594.             } else {
  5595.                 ::combobox::setValue $widgets(this) [$widgets(this) get]
  5596.             }
  5597.         }
  5598.  
  5599.         "<Escape>" {
  5600.             $widgets(entry) delete 0 end
  5601.             $widgets(entry) insert 0 $oldValue
  5602.             if {[winfo ismapped $widgets(popup)]} {
  5603.                 $widgets(this) close
  5604.                 return -code break;
  5605.             }
  5606.         }
  5607.  
  5608.         "<Return>" {
  5609.             # did the value change?
  5610.             set newValue [set ::combobox::${w}::entryTextVariable]
  5611.             if {$oldValue != $newValue} {
  5612.                 callCommand $widgets(this) $newValue
  5613.             }
  5614.  
  5615.             if 0 {
  5616.             if {$options(-editable)} {
  5617.                 # if there is something in the list that is selected,
  5618.                 # we'll pick it. Otherwise, use whats in the
  5619.                 # entry widget...
  5620.                 set index [$widgets(listbox) curselection]
  5621.                 if {[winfo ismapped $widgets(popup)] && \
  5622.                         [llength $index] > 0} {
  5623.  
  5624.                     ::combobox::select $widgets(this) \
  5625.                             [$widgets(listbox) curselection]
  5626.                     return -code break;
  5627.  
  5628.                 } else {
  5629.                     # the value doesn't change in this case, but we
  5630.                     # do need to arrange for the -command to be called
  5631.                     callCommand $widgets(this) \
  5632.                             [set ::combobox::${w}::entryTextVariable]
  5633.                     $widgets(this) close
  5634.  
  5635.                     return
  5636.                 }
  5637.             }
  5638.             }
  5639.  
  5640.             if {[winfo ismapped $widgets(popup)]} {
  5641.                 ::combobox::select $widgets(this) \
  5642.                         [$widgets(listbox) curselection]
  5643.                 return -code break;
  5644.             }
  5645.  
  5646.         }
  5647.  
  5648.         "<Next>" {
  5649.             $widgets(listbox) yview scroll 1 pages
  5650.             set index [$widgets(listbox) index @0,0]
  5651.             $widgets(listbox) see $index
  5652.             $widgets(listbox) activate $index
  5653.             $widgets(listbox) selection clear 0 end
  5654.             $widgets(listbox) selection anchor $index
  5655.             $widgets(listbox) selection set $index
  5656.  
  5657.         }
  5658.  
  5659.         "<Prior>" {
  5660.             $widgets(listbox) yview scroll -1 pages
  5661.             set index [$widgets(listbox) index @0,0]
  5662.             $widgets(listbox) activate $index
  5663.             $widgets(listbox) see $index
  5664.             $widgets(listbox) selection clear 0 end
  5665.             $widgets(listbox) selection anchor $index
  5666.             $widgets(listbox) selection set $index
  5667.         }
  5668.  
  5669.         "<Down>" {
  5670.             if {[winfo ismapped $widgets(popup)]} {
  5671.                 tkListboxUpDown $widgets(listbox) 1
  5672.                 return -code break;
  5673.  
  5674.             } else {
  5675.                 if {$options(-state) != "disabled"} {
  5676.                     $widgets(this) open
  5677.                     return -code break;
  5678.                 }
  5679.             }
  5680.         }
  5681.         "<Up>" {
  5682.             if {[winfo ismapped $widgets(popup)]} {
  5683.                 tkListboxUpDown $widgets(listbox) -1
  5684.                 return -code break;
  5685.  
  5686.             } else {
  5687.                 if {$options(-state) != "disabled"} {
  5688.                     $widgets(this) open
  5689.                     return -code break;
  5690.                 }
  5691.             }
  5692.         }
  5693.     }
  5694. }
  5695.  
  5696. # this cleans up the mess that is left behind when the widget goes away
  5697. # at least, that's the theory.
  5698. proc ::combobox::destroyHandler {w} {
  5699.  
  5700.     # kill any trace we may have started...
  5701.     namespace eval ::combobox::$w {
  5702.         variable options
  5703.         variable widgets
  5704.  
  5705.         # kill any trace we have for the user's -textvariable
  5706.         catch {
  5707.             if {[info exists options(-textvariable)]} {
  5708.                 if {[string length $options(-textvariable)]} {
  5709.                     trace vdelete $options(-textvariable) w \
  5710.                             [list ::combobox::vTrace $widgets(this)]
  5711.                 }
  5712.             }
  5713.         }
  5714.     }
  5715.  
  5716.     # kill the namespace
  5717.     catch {namespace delete ::combobox::$w}
  5718. }
  5719.  
  5720. # finds something in the listbox that matches the pattern in the
  5721. # entry widget
  5722. #
  5723. # I'm not convinced this is working the way it ought to. It works,
  5724. # but is the behavior what is expected? I've also got a gut feeling
  5725. # that there's a better way to do this, but I'm too lazy to figure
  5726. # it out...
  5727. proc ::combobox::find {w {exact 0}} {
  5728.     upvar ::combobox::${w}::widgets widgets
  5729.     upvar ::combobox::${w}::options options
  5730.  
  5731.     ## *sigh* this logic is rather gross and convoluted. Surely
  5732.     ## there is a more simple, straight-forward way to implement
  5733.     ## all this. As the saying goes, I lack the time to make it
  5734.     ## shorter...
  5735.  
  5736.     # use what is already in the entry widget as a pattern
  5737.     set pattern [$widgets(entry) get]
  5738.  
  5739.     if {[string length $pattern] == 0} {
  5740.         # clear the current selection
  5741.         $widgets(listbox) see 0
  5742.         $widgets(listbox) selection clear 0 end
  5743.         $widgets(listbox) selection anchor 0
  5744.         $widgets(listbox) activate 0
  5745.         return
  5746.     }
  5747.  
  5748.     # we're going to be searching this list...
  5749.     set list [$widgets(listbox) get 0 end]
  5750.  
  5751.     # if we are doing an exact match, try to find,
  5752.     # well, an exact match
  5753.     if {$exact} {
  5754.         set exactMatch [lsearch -exact $list $pattern]
  5755.     }
  5756.  
  5757.     # search for it. We'll try to be clever and not only
  5758.     # search for a match for what they typed, but a match for
  5759.     # something close to what they typed. We'll keep removing one
  5760.     # character at a time from the pattern until we find a match
  5761.     # of some sort.
  5762.     set index -1
  5763.     while {$index == -1 && [string length $pattern]} {
  5764.         set index [lsearch -glob $list "$pattern*"]
  5765.         if {$index == -1} {
  5766.             regsub {.$} $pattern {} pattern
  5767.         }
  5768.     }
  5769.  
  5770.     # this is the item that most closely matches...
  5771.     set thisItem [lindex $list $index]
  5772.  
  5773.     # did we find a match? If so, do some additional munging...
  5774.     if {$index != -1} {
  5775.  
  5776.         # we need to find the part of the first item that is
  5777.         # unique wrt the second... I know there's probably a
  5778.         # simpler way to do this...
  5779.  
  5780.         set nextIndex [expr {$index + 1}]
  5781.         set nextItem [lindex $list $nextIndex]
  5782.  
  5783.         # we don't really need to do much if the next
  5784.         # item doesn't match our pattern...
  5785.         if {[string match $pattern* $nextItem]} {
  5786.             # ok, the next item matches our pattern, too
  5787.             # now the trick is to find the first character
  5788.             # where they *don't* match...
  5789.             set marker [string length $pattern]
  5790.             while {$marker <= [string length $pattern]} {
  5791.                 set a [string index $thisItem $marker]
  5792.                 set b [string index $nextItem $marker]
  5793.                 if {[string compare $a $b] == 0} {
  5794.                     append pattern $a
  5795.                     incr marker
  5796.                 } else {
  5797.                     break
  5798.                 }
  5799.             }
  5800.         } else {
  5801.             set marker [string length $pattern]
  5802.         }
  5803.  
  5804.     } else {
  5805.         set marker end
  5806.         set index 0
  5807.     }
  5808.  
  5809.     # ok, we know the pattern and what part is unique;
  5810.     # update the entry widget and listbox appropriately
  5811.     if {$exact && $exactMatch == -1} {
  5812.         $widgets(listbox) selection clear 0 end
  5813.         $widgets(listbox) see $index
  5814.     } else {
  5815.         $widgets(entry) delete 0 end
  5816.         $widgets(entry) insert end $thisItem
  5817.         $widgets(entry) selection clear
  5818.         $widgets(entry) selection range $marker end
  5819.         $widgets(listbox) activate $index
  5820.         $widgets(listbox) selection clear 0 end
  5821.         $widgets(listbox) selection anchor $index
  5822.         $widgets(listbox) selection set $index
  5823.         $widgets(listbox) see $index
  5824.     }
  5825. }
  5826.  
  5827. # selects an item from the list and sets the value of the combobox
  5828. # to that value
  5829. proc ::combobox::select {w index} {
  5830.     upvar ::combobox::${w}::widgets widgets
  5831.     upvar ::combobox::${w}::options options
  5832.  
  5833.     catch {
  5834.         set data [$widgets(listbox) get [lindex $index 0]]
  5835.         ::combobox::setValue $widgets(this) $data
  5836.         $widgets(entry) selection range 0 end
  5837.     }
  5838.  
  5839.     $widgets(this) close
  5840. }
  5841.  
  5842. proc ::combobox::handleScrollbar {w {action "unknown"}} {
  5843.     upvar ::combobox::${w}::widgets widgets
  5844.     upvar ::combobox::${w}::options options
  5845.  
  5846.     if {$options(-height) == 0} {
  5847.         set hlimit $options(-maxheight)
  5848.     } else {
  5849.         set hlimit $options(-height)
  5850.     }
  5851.  
  5852.     switch $action {
  5853.         "grow" {
  5854.             if {$hlimit > 0 && [$widgets(listbox) size] > $hlimit} {
  5855.                 pack $widgets(vsb) -side right -fill y -expand n
  5856.             }
  5857.         }
  5858.  
  5859.         "shrink" {
  5860.             if {$hlimit > 0 && [$widgets(listbox) size] <= $hlimit} {
  5861.                 pack forget $widgets(vsb)
  5862.             }
  5863.         }
  5864.  
  5865.         "crop" {
  5866.             # this means the window was cropped and we definitely
  5867.             # need a scrollbar no matter what the user wants
  5868.             pack $widgets(vsb) -side right -fill y -expand n
  5869.         }
  5870.  
  5871.         default {
  5872.             if {$hlimit > 0 && [$widgets(listbox) size] > $hlimit} {
  5873.                 pack $widgets(vsb) -side right -fill y -expand n
  5874.             } else {
  5875.                 pack forget $widgets(vsb)
  5876.             }
  5877.         }
  5878.     }
  5879. }
  5880.  
  5881. # computes the geometry of the popup list based on the size of the
  5882. # combobox...
  5883. proc ::combobox::computeGeometry {w} {
  5884.     upvar ::combobox::${w}::widgets widgets
  5885.     upvar ::combobox::${w}::options options
  5886.  
  5887.     if {$options(-height) == 0 && $options(-maxheight) != "0"} {
  5888.         # if this is the case, count the items and see if
  5889.         # it exceeds our maxheight. If so, set the listbox
  5890.         # size to maxheight...
  5891.         set nitems [$widgets(listbox) size]
  5892.         if {$nitems > $options(-maxheight)} {
  5893.             # tweak the height of the listbox
  5894.             $widgets(listbox) configure -height $options(-maxheight)
  5895.         } else {
  5896.             # un-tweak the height of the listbox
  5897.             $widgets(listbox) configure -height 0
  5898.         }
  5899.         update idletasks
  5900.     }
  5901.  
  5902.     # compute height and width of the dropdown list
  5903.     set bd [$widgets(popup) cget -borderwidth]
  5904.     set height [expr {[winfo reqheight $widgets(popup)] + $bd + $bd}]
  5905.     set width [winfo width $widgets(this)]
  5906.  
  5907.     # figure out where to place it on the screen, trying to take into
  5908.     # account we may be running under some virtual window manager
  5909.     set screenWidth  [winfo screenwidth $widgets(this)]
  5910.     set screenHeight [winfo screenheight $widgets(this)]
  5911.     set rootx        [winfo rootx $widgets(this)]
  5912.     set rooty        [winfo rooty $widgets(this)]
  5913.     set vrootx       [winfo vrootx $widgets(this)]
  5914.     set vrooty       [winfo vrooty $widgets(this)]
  5915.  
  5916.     # the x coordinate is simply the rootx of our widget, adjusted for
  5917.     # the virtual window. We won't worry about whether the window will
  5918.     # be offscreen to the left or right -- we want the illusion that it
  5919.     # is part of the entry widget, so if part of the entry widget is off-
  5920.     # screen, so will the list. If you want to change the behavior,
  5921.     # simply change the if statement... (and be sure to update this
  5922.     # comment!)
  5923.     set x  [expr {$rootx + $vrootx}]
  5924.     if {0} {
  5925.         set rightEdge [expr {$x + $width}]
  5926.         if {$rightEdge > $screenWidth} {
  5927.             set x [expr {$screenWidth - $width}]
  5928.         }
  5929.         if {$x < 0} {set x 0}
  5930.     }
  5931.  
  5932.     # the y coordinate is the rooty plus vrooty offset plus
  5933.     # the height of the static part of the widget plus 1 for a
  5934.     # tiny bit of visual separation...
  5935.     set y [expr {$rooty + $vrooty + [winfo reqheight $widgets(this)] + 1}]
  5936.     set bottomEdge [expr {$y + $height}]
  5937.  
  5938.     if {$bottomEdge >= $screenHeight} {
  5939.         # ok. Fine. Pop it up above the entry widget isntead of
  5940.         # below.
  5941.         set y [expr {($rooty - $height - 1) + $vrooty}]
  5942.  
  5943.         if {$y < 0} {
  5944.             # this means it extends beyond our screen. How annoying.
  5945.             # Now we'll try to be real clever and either pop it up or
  5946.             # down, depending on which way gives us the biggest list.
  5947.             # then, we'll trim the list to fit and force the use of
  5948.             # a scrollbar
  5949.  
  5950.             # (sadly, for windows users this measurement doesn't
  5951.             # take into consideration the height of the taskbar,
  5952.             # but don't blame me -- there isn't any way to detect
  5953.             # it or figure out its dimensions. The same probably
  5954.             # applies to any window manager with some magic windows
  5955.             # glued to the top or bottom of the screen)
  5956.  
  5957.             if {$rooty > [expr {$screenHeight / 2}]} {
  5958.                 # we are in the lower half of the screen --
  5959.                 # pop it up. Y is zero; that parts easy. The height
  5960.                 # is simply the y coordinate of our widget, minus
  5961.                 # a pixel for some visual separation. The y coordinate
  5962.                 # will be the topof the screen.
  5963.                 set y 1
  5964.                 set height [expr {$rooty - 1 - $y}]
  5965.  
  5966.             } else {
  5967.                 # we are in the upper half of the screen --
  5968.                 # pop it down
  5969.                 set y [expr {$rooty + $vrooty + \
  5970.             [winfo reqheight $widgets(this)] + 1}]
  5971.                 set height [expr {$screenHeight - $y}]
  5972.  
  5973.     }
  5974.  
  5975.             # force a scrollbar
  5976.             handleScrollbar $widgets(this) crop
  5977.         }
  5978.     }
  5979.  
  5980.     if {$y < 0} {
  5981.         # hmmm. Bummer.
  5982.         set y 0
  5983.         set height $screenheight
  5984.     }
  5985.  
  5986.     set geometry [format "=%dx%d+%d+%d" $width $height $x $y]
  5987.     return $geometry
  5988. }
  5989.  
  5990. # perform an internal widget command, then mung any error results
  5991. # to look like it came from our megawidget. A lot of work just to
  5992. # give the illusion that our megawidget is an atomic widget
  5993. proc ::combobox::doInternalWidgetCommand {w subwidget command args} {
  5994.     upvar ::combobox::${w}::widgets widgets
  5995.     upvar ::combobox::${w}::options options
  5996.  
  5997.     set subcommand $command
  5998.     set command [concat $widgets($subwidget) $command $args]
  5999.     if {[catch $command result]} {
  6000.         # replace the subwidget name with the megawidget name
  6001.         regsub $widgets($subwidget) $result $widgets(this) result
  6002.  
  6003.         # replace specific instances of the subwidget command
  6004.         # with out megawidget command
  6005.         switch $subwidget,$subcommand {
  6006.             listbox,index  {regsub "index"  $result "list index"  result}
  6007.             listbox,insert {regsub "insert" $result "list insert" result}
  6008.             listbox,delete {regsub "delete" $result "list delete" result}
  6009.             listbox,get    {regsub "get"    $result "list get"    result}
  6010.             listbox,size   {regsub "size"   $result "list size"   result}
  6011.         }
  6012.         error $result
  6013.  
  6014.     } else {
  6015.         return $result
  6016.     }
  6017. }
  6018.  
  6019.  
  6020. # this is the widget proc that gets called when you do something like
  6021. # ".checkbox configure ..."
  6022. proc ::combobox::widgetProc {w command args} {
  6023.     upvar ::combobox::${w}::widgets widgets
  6024.     upvar ::combobox::${w}::options options
  6025.     upvar ::combobox::${w}::oldFocus oldFocus
  6026.     upvar ::combobox::${w}::oldFocus oldGrab
  6027.  
  6028.     # this is just shorthand notation...
  6029.     set doWidgetCommand \
  6030.             [list ::combobox::doInternalWidgetCommand $widgets(this)]
  6031.  
  6032.     if {$command == "list"} {
  6033.         # ok, the next argument is a list command; we'll
  6034.         # rip it from args and append it to command to
  6035.         # create a unique internal command
  6036.         #
  6037.         # NB: because of the sloppy way we are doing this,
  6038.         # we'll also let the user enter our secret command
  6039.         # directly (eg: listinsert, listdelete), but we
  6040.         # won't document that fact
  6041.         set command "list[lindex $args 0]"
  6042.         set args [lrange $args 1 end]
  6043.     }
  6044.  
  6045.     # many of these commands are just synonyms for specific
  6046.     # commands in one of the subwidgets. We'll get them out
  6047.     # of the way first, then do the custom commands.
  6048.     switch $command {
  6049.         bbox            {eval $doWidgetCommand entry bbox $args}
  6050.         delete          {eval $doWidgetCommand entry delete $args}
  6051.         get             {eval $doWidgetCommand entry get $args}
  6052.         icursor         {eval $doWidgetCommand entry icursor $args}
  6053.         index           {eval $doWidgetCommand entry index $args}
  6054.         insert          {eval $doWidgetCommand entry insert $args}
  6055.         scan            {eval $doWidgetCommand entry scan $args}
  6056.         selection       {eval $doWidgetCommand entry selection $args}
  6057.         xview           {eval $doWidgetCommand entry xview $args}
  6058.         listget         {eval $doWidgetCommand listbox get $args}
  6059.         listindex       {eval $doWidgetCommand listbox index $args}
  6060.         listsize        {eval $doWidgetCommand listbox size $args}
  6061.  
  6062.         subwidget {
  6063.             set knownWidgets [list button entry listbox popup vsb]
  6064.             if {[llength $args] == 0} {
  6065.                 return $knownWidgets
  6066.             }
  6067.  
  6068.             set name [lindex $args 0]
  6069.             if {[lsearch $knownWidgets $name] != -1} {
  6070.                 return $widgets($name)
  6071.             } else {
  6072.                 error "unknown subwidget $name"
  6073.             }
  6074.         }
  6075.  
  6076.         listinsert {
  6077.             eval $doWidgetCommand listbox insert $args
  6078.             handleScrollbar $w "grow"
  6079.         }
  6080.  
  6081.         listdelete {
  6082.             eval $doWidgetCommand listbox delete $args
  6083.             handleScrollbar $w "shrink"
  6084.         }
  6085.  
  6086.         toggle {
  6087.             # ignore this command if the widget is disabled...
  6088.             if {$options(-state) == "disabled"} return
  6089.  
  6090.             # pops down the list if it is not, hides it
  6091.             # if it is...
  6092.             if {[winfo ismapped $widgets(popup)]} {
  6093.                 $widgets(this) close
  6094.             } else {
  6095.                 $widgets(this) open
  6096.             }
  6097.         }
  6098.  
  6099.         open {
  6100.  
  6101.             # if this is an editable combobox, the focus should
  6102.             # be set to the entry widget
  6103.             if {$options(-editable)} {
  6104.                 focus $widgets(entry)
  6105.                 $widgets(entry) select range 0 end
  6106.                 $widgets(entry) icur end
  6107.             }
  6108.  
  6109.             # if we are disabled, we won't allow this to happen
  6110.             if {$options(-state) == "disabled"} {
  6111.                 return 0
  6112.             }
  6113.  
  6114.             # compute the geometry of the window to pop up, and set
  6115.             # it, and force the window manager to take notice
  6116.             # (even if it is not presently visible).
  6117.             #
  6118.             # this isn't strictly necessary if the window is already
  6119.             # mapped, but we'll go ahead and set the geometry here
  6120.             # since its harmless and *may* actually reset the geometry
  6121.             # to something better in some weird case.
  6122.             set geometry [::combobox::computeGeometry $widgets(this)]
  6123.             wm geometry $widgets(popup) $geometry
  6124.             update idletasks
  6125.  
  6126.             # if we are already open, there's nothing else to do
  6127.             if {[winfo ismapped $widgets(popup)]} {
  6128.                 return 0
  6129.             }
  6130.  
  6131.             # save the widget that currently has the focus; we'll restore
  6132.             # the focus there when we're done
  6133.             set oldFocus [focus]
  6134.  
  6135.             # ok, tweak the visual appearance of things and
  6136.             # make the list pop up
  6137.             $widgets(button) configure -relief sunken
  6138.             wm deiconify $widgets(popup)
  6139.             raise $widgets(popup) [winfo parent $widgets(this)]
  6140.  
  6141.             # force focus to the entry widget so we can handle keypress
  6142.             # events for traversal
  6143.             focus -force $widgets(entry)
  6144.  
  6145.             # select something by default, but only if its an
  6146.             # exact match...
  6147.             ::combobox::find $widgets(this) 1
  6148.  
  6149.             # save the current grab state for the display containing
  6150.             # this widget. We'll restore it when we close the dropdown
  6151.             # list
  6152.             set status "none"
  6153.             set grab [grab current $widgets(this)]
  6154.             if {$grab != ""} {set status [grab status $grab]}
  6155.             set oldGrab [list $grab $status]
  6156.             unset grab status
  6157.  
  6158.             # *gasp* do a global grab!!! Mom always told not to
  6159.             # do things like this, but these are desparate times.
  6160.             grab -global $widgets(this)
  6161.  
  6162.             # fake the listbox into thinking it has focus. This is
  6163.             # necessary to get scanning initialized properly in the
  6164.             # listbox.
  6165.             event generate $widgets(listbox) <B1-Enter>
  6166.  
  6167.             return 1
  6168.         }
  6169.  
  6170.         close {
  6171.             # if we are already closed, don't do anything...
  6172.             if {![winfo ismapped $widgets(popup)]} {
  6173.                 return 0
  6174.             }
  6175.  
  6176.             # restore the focus and grab, but ignore any errors...
  6177.             # we're going to be paranoid and release the grab before
  6178.             # trying to set any other grab because we really really
  6179.             # really want to make sure the grab is released.
  6180.             catch {focus $oldFocus} result
  6181.             catch {grab release $widgets(this)}
  6182.             catch {
  6183.                 set status [lindex $oldGrab 1]
  6184.                 if {$status == "global"} {
  6185.                     grab -global [lindex $oldGrab 0]
  6186.                 } elseif {$status == "local"} {
  6187.                     grab [lindex $oldGrab 0]
  6188.                 }
  6189.                 unset status
  6190.             }
  6191.  
  6192.             # hides the listbox
  6193.             $widgets(button) configure -relief raised
  6194.             wm withdraw $widgets(popup)
  6195.  
  6196.             # select the data in the entry widget. Not sure
  6197.             # why, other than observation seems to suggest that's
  6198.             # what windows widgets do.
  6199.             set editable [::combobox::getBoolean $options(-editable)]
  6200.             if {$editable} {
  6201.                 $widgets(entry) selection range 0 end
  6202.                 $widgets(button) configure -relief raised
  6203.             }
  6204.  
  6205.  
  6206.             # magic tcl stuff (see tk.tcl in the distribution
  6207.             # lib directory)
  6208.             tkCancelRepeat
  6209.  
  6210.             return 1
  6211.         }
  6212.  
  6213.         cget {
  6214.             # tries to mimic the standard "cget" command
  6215.             if {[llength $args] != 1} {
  6216.                 error "wrong # args: should be \"$widgets(this) cget option\""
  6217.             }
  6218.             set option [lindex $args 0]
  6219.             return [::combobox::configure $widgets(this) cget $option]
  6220.         }
  6221.  
  6222.         configure {
  6223.             # trys to mimic the standard "configure" command
  6224.             if {[llength $args] == 0} {
  6225.                 # this isn't the same format as "real" widgets,
  6226.                 # but for now its good enough
  6227.                 foreach item [lsort [array names options]] {
  6228.                     lappend result [list $item $options($item)]
  6229.                 }
  6230.                 return $result
  6231.  
  6232.             } elseif {[llength $args] == 1} {
  6233.                 # they are requesting configure information...
  6234.                 set option [lindex $args 0]
  6235.                 return [::combobox::configure $widgets(this) get $option]
  6236.             } else {
  6237.                 array set tmpopt $args
  6238.                 foreach opt [array names tmpopt] {
  6239.                     ::combobox::configure $widgets(this) set $opt $tmpopt($opt)
  6240.                 }
  6241.             }
  6242.         }
  6243.         default {
  6244.             error "bad option \"$command\""
  6245.         }
  6246.     }
  6247. }
  6248.  
  6249. # handles all of the configure and cget foo
  6250. proc ::combobox::configure {w action {option ""} {newValue ""}} {
  6251.     upvar ::combobox::${w}::widgets widgets
  6252.     upvar ::combobox::${w}::options options
  6253.     set namespace "::combobox::${w}"
  6254.  
  6255.     if {$action == "get"} {
  6256.         # this really ought to do more than just get the value,
  6257.         # but for the time being I don't fully support the configure
  6258.         # command in all its glory...
  6259.         if {$option == "-value"} {
  6260.             return [list "-value" [$widgets(entry) get]]
  6261.         } else {
  6262.             return [list $option $options($option)]
  6263.         }
  6264.  
  6265.     } elseif {$action == "cget"} {
  6266.         if {$option == "-value"} {
  6267.             return [$widgets(entry) get]
  6268.         } else {
  6269.             return $options($option)
  6270.         }
  6271.  
  6272.     } else {
  6273.  
  6274.         if {[info exists options($option)]} {
  6275.             set oldValue $options($option)
  6276.             set options($option) $newValue
  6277.         } else {
  6278.             set oldValue ""
  6279.             set options($option) $newValue
  6280.         }
  6281.  
  6282.         # some (actually, most) options require us to
  6283.         # do something, like change the attributes of
  6284.         # a widget or two. Here's where we do that...
  6285.         switch -- $option {
  6286.             -background {
  6287.                 $widgets(frame)   configure -background $newValue
  6288.                 $widgets(entry)   configure -background $newValue
  6289.                 $widgets(listbox) configure -background $newValue
  6290.                 $widgets(vsb)     configure -background $newValue
  6291.                 $widgets(vsb)     configure -troughcolor $newValue
  6292.             }
  6293.  
  6294.             -borderwidth {
  6295.                 $widgets(frame) configure -borderwidth $newValue
  6296.             }
  6297.  
  6298.             -command {
  6299.                 # nothing else to do...
  6300.             }
  6301.  
  6302.             -commandstate {
  6303.                 # do some value checking...
  6304.                 if {$newValue != "normal" && $newValue != "disabled"} {
  6305.                     set options($option) $oldValue
  6306.                     error "bad state value \"$newValue\"; must be normal or disabled"
  6307.                 }
  6308.             }
  6309.  
  6310.             -cursor {
  6311.                 $widgets(frame) configure -cursor $newValue
  6312.                 $widgets(entry) configure -cursor $newValue
  6313.                 $widgets(listbox) configure -cursor $newValue
  6314.             }
  6315.  
  6316.             -editable {
  6317.                 if {$newValue} {
  6318.                     # it's editable...
  6319.                     $widgets(entry) configure -state normal
  6320.                 } else {
  6321.                     $widgets(entry) configure -state disabled
  6322.                 }
  6323.             }
  6324.  
  6325.             -font {
  6326.                 $widgets(entry) configure -font $newValue
  6327.                 $widgets(listbox) configure -font $newValue
  6328.             }
  6329.  
  6330.             -foreground {
  6331.                 $widgets(entry)   configure -foreground $newValue
  6332.                 $widgets(button)  configure -foreground $newValue
  6333.                 $widgets(listbox) configure -foreground $newValue
  6334.             }
  6335.  
  6336.             -height {
  6337.                 $widgets(listbox) configure -height $newValue
  6338.                 handleScrollbar $w
  6339.             }
  6340.  
  6341.             -highlightbackground {
  6342.                 $widgets(frame) configure -highlightbackground $newValue
  6343.             }
  6344.  
  6345.             -highlightcolor {
  6346.                 $widgets(frame) configure -highlightcolor $newValue
  6347.             }
  6348.  
  6349.             -highlightthickness {
  6350.                 $widgets(frame) configure -highlightthickness $newValue
  6351.             }
  6352.  
  6353.             -image {
  6354.                 if {[string length $newValue] > 0} {
  6355.                     $widgets(button) configure -image $newValue
  6356.                 } else {
  6357.                     $widgets(button) configure -image ::combobox::bimage
  6358.                 }
  6359.             }
  6360.  
  6361.             -maxheight {
  6362.                 # computeGeometry may dork with the actual height
  6363.                 # of the listbox, so let's undork it
  6364.                 $widgets(listbox) configure -height $options(-height)
  6365.                 handleScrollbar $w
  6366.             }
  6367.  
  6368.             -relief {
  6369.                 $widgets(frame) configure -relief $newValue
  6370.             }
  6371.  
  6372.             -selectbackground {
  6373.                 $widgets(entry) configure -selectbackground $newValue
  6374.                 $widgets(listbox) configure -selectbackground $newValue
  6375.             }
  6376.  
  6377.             -selectborderwidth {
  6378.                 $widgets(entry) configure -selectborderwidth $newValue
  6379.                 $widgets(listbox) configure -selectborderwidth $newValue
  6380.             }
  6381.  
  6382.             -selectforeground {
  6383.                 $widgets(entry) configure -selectforeground $newValue
  6384.                 $widgets(listbox) configure -selectforeground $newValue
  6385.             }
  6386.  
  6387.             -state {
  6388.                 if {$newValue == "normal"} {
  6389.                     # it's enabled
  6390.                     set editable [::combobox::getBoolean \
  6391.                             $options(-editable)]
  6392.                     if {$editable} {
  6393.                         $widgets(entry) configure -state normal
  6394.                         $widgets(entry) configure -takefocus 1
  6395.                     }
  6396.                 } elseif {$newValue == "disabled"}  {
  6397.                     # it's disabled
  6398.                     $widgets(entry) configure -state disabled
  6399.                     $widgets(entry) configure -takefocus 0
  6400.  
  6401.                 } else {
  6402.                     set options($option) $oldValue
  6403.                     error "bad state value \"$newValue\"; must be normal or disabled"
  6404.                 }
  6405.  
  6406.             }
  6407.  
  6408.             -takefocus {
  6409.                 $widgets(entry) configure -takefocus $newValue
  6410.             }
  6411.  
  6412.             -textvariable {
  6413.                 # destroy our trace on the old value, if any
  6414.                 if {[string length $oldValue] > 0} {
  6415.                     trace vdelete $oldValue w \
  6416.                             [list ::combobox::vTrace $widgets(this)]
  6417.                 }
  6418.                 # set up a trace on the new value, if any. Also, set
  6419.                 # the value of the widget to the current value of
  6420.                 # the variable
  6421.  
  6422.                 set variable ::$newValue
  6423.                 if {[string length $newValue] > 0} {
  6424.                     if {[info exists $variable]} {
  6425.                         ::combobox::setValue $widgets(this) [set $variable]
  6426.                     }
  6427.                     trace variable $variable w \
  6428.                             [list ::combobox::vTrace $widgets(this)]
  6429.                 }
  6430.             }
  6431.  
  6432.             -value {
  6433.                 ::combobox::setValue $widgets(this) $newValue
  6434.             }
  6435.  
  6436.             -width {
  6437.                 $widgets(entry) configure -width $newValue
  6438.                 $widgets(listbox) configure -width $newValue
  6439.             }
  6440.  
  6441.             -xscrollcommand {
  6442.                 $widgets(entry) configure -xscrollcommand $newValue
  6443.             }
  6444.  
  6445.             default {
  6446.                 error "unknown option \"$option\""
  6447.             }
  6448.         }
  6449.     }
  6450. }
  6451.  
  6452. # this proc is called whenever the user changes the value of
  6453. # the -textvariable associated with a widget
  6454. proc ::combobox::vTrace {w args} {
  6455.     upvar ::combobox::${w}::widgets widgets
  6456.     upvar ::combobox::${w}::options options
  6457.     upvar ::combobox::${w}::ignoreTrace ignoreTrace
  6458.  
  6459.     if {[info exists ignoreTrace]} return
  6460.     ::combobox::setValue $widgets(this) [set ::$options(-textvariable)]
  6461. }
  6462.  
  6463. # sets the value of the combobox and calls the -command, if defined
  6464. proc ::combobox::setValue {w newValue {index -1}} {
  6465.     upvar ::combobox::${w}::widgets     widgets
  6466.     upvar ::combobox::${w}::options     options
  6467.     upvar ::combobox::${w}::ignoreTrace ignoreTrace
  6468.     upvar ::combobox::${w}::oldValue    oldValue
  6469.  
  6470.     # set our internal textvariable; this will cause any public
  6471.     # textvariable (ie: defined by the user) to be updated as
  6472.     # well
  6473.     set ::combobox::${w}::entryTextVariable $newValue
  6474.  
  6475.     # redefine our concept of the "old value". Do it before running
  6476.     # any associated command so we can be sure it happens even
  6477.     # if the command somehow fails.
  6478.     set oldValue $newValue
  6479.  
  6480.     # call the associated command. The proc will handle whether or
  6481.     # not to actually call it, and with what args
  6482.     callCommand $w $newValue
  6483. }
  6484.  
  6485. # call the associated command, if any
  6486. proc ::combobox::callCommand {w newValue} {
  6487.     upvar ::combobox::${w}::widgets widgets
  6488.     upvar ::combobox::${w}::options options
  6489.  
  6490.     # call the associated command, if defined and -commandstate is
  6491.     # set to "normal"
  6492.     if {$options(-commandstate) == "normal" && \
  6493.             [string length $options(-command)] > 0} {
  6494.         set args [list $widgets(this) $newValue]
  6495.         uplevel \#0 $options(-command) $args
  6496.     }
  6497. }
  6498.  
  6499.  
  6500. # returns the value of a (presumably) boolean string (ie: it should
  6501. # do the right thing if the string is "yes", "no", "true", 1, etc
  6502. proc ::combobox::getBoolean {value {errorValue 1}} {
  6503.     if {[catch {expr {([string trim $value])?1:0}} res]} {
  6504.         return $errorValue
  6505.     } else {
  6506.         return $res
  6507.     }
  6508. }
  6509.  
  6510. # computes the combobox widget name based on the name of one of
  6511. # it's children widgets.. Not presently used, but might come in
  6512. # handy...
  6513. proc ::combobox::widgetName {w} {
  6514.     while {$w != "."} {
  6515.         if {[winfo class $w] == "Combobox"} {
  6516.             return $w
  6517.         }
  6518.         set w [winfo parent $w]
  6519.     }
  6520.     error "internal error: $w is not a child of a combobox"
  6521. }
  6522.  
  6523.  
  6524. # end of combobox.tcl
  6525.  
  6526. # run the main proc
  6527. main
  6528.